xts/0000755000176200001440000000000014553240732011075 5ustar liggesusersxts/NAMESPACE0000644000176200001440000001423414525744640012326 0ustar liggesusers# load symbol table useDynLib(xts, .registration = TRUE, .fixes = "C_") # non-base package imports importFrom(stats, lag, time, sd, median, na.omit, na.action, na.pass, start, end, window, setNames, ts, as.ts, frequency, tsp, 'tsp<-') importFrom(methods, hasArg) importFrom(grDevices, xy.coords) importFrom(graphics, abline, clip, legend, lines, par, plot, plot.new, plot.window, polygon, segments, text) importFrom(utils, str, tail) # xts exports export(.parseISO8601) export(firstof, lastof) export(is.timeBased, timeBased, timeBasedRange, timeBasedSeq) export(.indexsec, .indexmin, .indexhour, .indexday, .indexDate, .indexmon, .indexmday, .indexwday, .indexyday, .indexisdst, .indexyear, .indexweek) export(isOrdered) export(.subset.xts) export(.subset_xts) # user visible core xts functions export(xts, .xts) export(as.xts) export(is.xts) export(endpoints) export(align.time) export(shift.time) export(adj.time) export(make.index.unique) export(make.time.unique) export(is.time.unique) export(is.index.unique) export(dimnames.xts) export('dimnames<-.xts') export(xcoredata) export('xcoredata<-') export(.index) export('.index<-') export(xtsible) export(as.environment.xts) export(use.xts, try.xts) export(Reclass, use.reclass) export(reclass) export(CLASS) export('CLASS<-') export(indexFormat) export('indexFormat<-') export(tformat) export('tformat<-') export(indexClass) export('indexClass<-') export(tclass) export('tclass<-') export(indexTZ) export('indexTZ<-') export(tzone) export('tzone<-') export(convertIndex) export(nseconds, nminutes, nhours, ndays, nweeks, nmonths, nquarters, nyears) export(to_period) # testing export(to.period, to.minutes, to.minutes3, to.minutes5, to.minutes10, to.minutes15, to.minutes30, to.hourly, to.daily, to.weekly, to.monthly, to.quarterly, to.yearly) export(xtsAttributes) export('xtsAttributes<-') export(periodicity) export(period.apply, period.max, period.min, period.sum, period.prod) export(first, last) export(apply.daily, apply.weekly, apply.monthly, apply.quarterly, apply.yearly) export(rbind.xts, cbind.xts, c.xts) export(split.xts) export(axTicksByTime) export(plot.xts) export(addLegend) export(addEventLines) # export(addPoints) export(addSeries) export(addPanel) export(addPolygon) S3method(plot,xts) S3method(lines,xts) S3method(points,xts) S3method(print, replot_xts) S3method(plot, replot_xts) S3method(str, replot_xts) #export(lines.xts) #S3method(lines,xts) #S3method(points,xts) #export(Lag.xts, Next.xts) #, Diff.xts) export(lag.xts) export(diff.xts) export(merge.xts) #export(mergeXts) S3method(all.equal, xts) S3method(split, xts) S3method(lag,xts) S3method(diff,xts) S3method(first,default) S3method(last,default) S3method(first,xts) S3method(last,xts) S3method(print,periodicity) S3method(align.time, xts) S3method(align.time, POSIXct) S3method(align.time, POSIXlt) S3method(shift.time, xts) S3method(make.index.unique, xts) S3method(make.index.unique, numeric) S3method(make.index.unique, POSIXct) S3method(is.time.unique, xts) S3method(is.time.unique, zoo) # xts methods importFrom(zoo,coredata) importFrom(zoo, index) importFrom(zoo,'index<-') importFrom(zoo,'time<-') importFrom(zoo, na.locf) importFrom(zoo, as.zoo) #importFrom(zoo, lagts) importFrom(zoo, rollapply) importFrom(zoo, na.approx) importFrom(zoo, na.fill) importFrom(zoo, na.fill0) importFrom(zoo, as.yearmon) importFrom(zoo, as.yearqtr) importFrom(zoo, is.regular) importFrom(zoo, zoo) importFrom(zoo, MATCH) S3method(coredata,xts) S3method(xcoredata,default) S3method('xcoredata<-',default) S3method(as.xts,xts) S3method('[',xts) S3method('[<-',xts) S3method(str,xts) S3method(start, xts) S3method(end, xts) S3method(na.omit,xts) S3method(na.locf,xts) S3method(na.fill,xts) S3method(print,xts) S3method(print,CLASS) S3method('CLASS<-',xts) S3method(window,xts) S3method(dimnames, xts) S3method('dimnames<-', xts) S3method(tclass, default) S3method('tclass<-', default) S3method(tclass,xts) S3method('tclass<-',xts) S3method(tformat,default) S3method(tformat,xts) S3method('tformat<-',xts) S3method(tzone, default) S3method('tzone<-', default) S3method(tzone,xts) S3method('tzone<-',xts) S3method('index',xts) S3method('index<-',xts) S3method('time<-',xts) S3method('xtsAttributes<-',xts) S3method(merge,xts) S3method(rbind,xts) S3method(cbind,xts) S3method(c,xts) S3method(Ops,xts) S3method(as.numeric,xts) S3method(as.xts,numeric) S3method(as.double,xts) S3method(as.xts,double) S3method(as.integer,xts) S3method(as.xts,integer) S3method(as.complex,xts) S3method(as.xts,complex) S3method(as.logical,xts) S3method(as.xts,logical) S3method(cumsum, xts) S3method(cumprod, xts) S3method(cummin, xts) S3method(cummax, xts) #S3method(lagts,xts) S3method(rollapply, xts) # list specific methods S3method(as.list,xts) # ts specific methods S3method(as.xts, ts) S3method(as.ts, xts) # zoo specific methods #importFrom(zoo,as.zoo) # now in zoo S3method(as.xts,zoo) if (getRversion() >= "3.6.0" && utils::packageVersion("zoo") < "1.8.5") { # xts:::as.zoo.xts was copied to zoo:::as.zoo.xts in zoo 1.8-5 S3method(zoo::as.zoo, xts) } # data.frame specific methods S3method(as.xts,data.frame) S3method(as.data.frame, xts) # matrix specific methods S3method(as.xts,matrix) S3method(as.matrix,xts) # environment specific methods #S3method(as.xts,environment) S3method(as.environment,xts) # timeSeries (package:timeSeries) specific methods if (getRversion() >= "3.6.0") { S3method(timeSeries::as.timeSeries, xts) } S3method(as.xts,timeSeries) # irts (package:tseries) specific methods S3method(as.xts,irts) # Date specific methods S3method(as.xts,Date) # POSIX specific methods S3method(as.xts,POSIXt) # yearmon/yearqtr specific methods S3method(as.xts,yearmon) S3method(as.xts,yearqtr) # timeDate specific methods S3method(as.xts,timeDate) ## currently unexported functions that _may_ be exported at some point #export(startof,endof,firstof,lastof) xts/data/0000755000176200001440000000000014552546765012024 5ustar liggesusersxts/data/sample_matrix.rda0000644000176200001440000001204114522244665015346 0ustar liggesusersy8UM24SH=VQ4BL% tTTN"ʡTƒ(SB κ{zk?|^mhΑ6RL ­]N9{ԀtyU닊YR#yQ`F}[ Q]8 ~fQ+oe𾔭q[fvS9缀pzj0w08kN 0 oWtꤪ$['=Hx&q魱k۟$S%XǭÏRY*ӷv$0Vs\fѴ",umcu@VU1.lպ&Dz J!_bpX  K/7;f h`BKN9̍ar2oWF`6K7%l7n?E/MU``lU ?;}:0Ket:t<cMwN̘e1Ge˝@nqn3p Ϋơ@Ho; [}ߝ z|m:j @?7:L]qR:^xST[Տ6?ڴ h԰F( T3Ralˎ&seW;Π@{m9d2^vG|ɠ@5orsBlV>R-  `/쮤4Q= -7~x:;􁮟0sI tm[Q|?rLÚm];]ON r۴%MR?b+Y̬ɯ*O΢.3xt [:OhE+g0~ú.Pt}8YW.ՒT N5@?꫞ =PHc~,IM:bq/42Gs@KL80z@ 2Р I@U,sr]9@o؇V]철lzL0=5hap>P=vvkU!dL&PܯmX?GJGcjD<ӽMܳ9׬e5Gi+f\:4:r5O؀7{!`ee ՄX{C g Z[z]ElAb`<s;Y+/^׿l̙ʩRڪdLeǚT`O Zk`0Jƒopf^*dB#q/qsF;)qh\؛00$題w)ٚ.1ϞP~M|Y艜׳l.}\k1s1{s Y?W=2jR3GQ8~pNGz>P/.ȕ@[\(kNw=rw@Yf~xw-*X?W?sMHDO\ ꝬtǑsj%PezƊa\GES7oj`짴crglEAqgb,{mdn+U#q?p=κ1/p>ty1_c*Mng?]U7KzfϷ_{bߒ%Aw$xK&<t !9-+GZϛ~:*ΐa}`o? zq{"%];n.:uOi6qtd—r`y_Lc\#NbwMӾ8f5+Nsj?іE9%Qz"Tk@\g) u%QQ[mO{]FUw}qR@(Dn4zLp6?3|]om6?{:Ի7d-^O+)NƉ~Z\*(\z>?D+(IfX;~݂C1!S"o|†Sl/1}?Rbn٭duzi"@߰ʫK ,}&m4ƈqo25kWe+mm-l=ꥑ=^W=@ Ioz&_3uWA@ooX4z$jUes&!6?7vd>YTK"17w[l4ho D|U淹qzg-fgtys$,\iЕ_c4P1Bπ$l֊*h Tn9wv|̝Jz~S^ F.ŹG;bCjkύȟ>WxKﺧ[伢M$+?<)rKs(̃ߓg\ ;ܸx5rzv6}\!ܒ:i2&OMjڿ50-g>y۝䪴;=jmg߫sgN"ۿؤOY?ovRg+ơKnLl4g "[ȭqXʢv*8>Q:q̛W6s_@*o˪j;]~qQY'լ܆ٚ=꬟̃".Ԇ574ˇ%In]ǬwkER/.%󬃺N/7cdUz ܢhWtWKϷz̝ ޮF=4_Q!OAoKEԕIVӃ&U{ԡm̈{/az𵙸.uݦl=syo)MTr4@3 l~~^ZR+Db.-R6,;Km?Lx,(e\sTy z~> WAO?y~'?60#E/1.G+dV5|6~7zrƺ뭬˭|5L\Z~̈́yna=%ѯ;m 3w^+? c3=y[s`\)ܦ"爰~g4$ssGqRy5XV}E\~V߱~!xq9--Zs8#|bD@#Ĉ#ZĈ61BԬMԬMԬMԬMԬMԬMԬM!j5s9DfQ3C!j5sAbCp1'FĈ1K>;-A C!hpZ8-A C!hpZ8-A ;;;;;;;;;;;;;;;;;;;;;;;;;;;wKp Kp KZx-<A G#hZx-<A G#hZx-<A G#hZx-<A G'l 6| >`O'l 6| >`O'l 6| >`O'l 6| awZ-AE@" hZ-AE@" hZ-AE@" hZ-AE|^U^Ny-j#:y8?S0[#xts/man/0000755000176200001440000000000014525744667011667 5ustar liggesusersxts/man/timeBasedSeq.Rd0000644000176200001440000000660114522244666014516 0ustar liggesusers\name{timeBasedSeq} \alias{timeBasedSeq} \alias{timeBasedRange} \title{ Create a Sequence or Range of Times } \description{ A function to create a vector of time-based objects suitable for indexing an \emph{xts} object, given a string conforming to the ISO 8601 time and date standard for range-based specification. The resultant series can be of any class supported by \emph{xts}, including POSIXct, Date, chron, timeDate, yearmon, and yearqtr. \code{timeBasedRange} creates a vector of length 1 or 2 as seconds since the epoch (1970-01-01) for use internally. } \usage{ timeBasedSeq(x, retclass = NULL, length.out = NULL) timeBasedRange(x, ...) } \arguments{ \item{x}{ a string representing the time-date range desired } \item{retclass}{ the return class desired } \item{length.out}{ passed to \code{seq} internally } \item{\ldots}{ unused } } \details{ Designed to provide uniform creation of valid time-based objects for use within \emph{xts}, the interface conforms (mostly) to the ISO recommended format for specifying ranges. In general, the format is a string specifying a time and/or date \emph{from}, \emph{to}, and optionally \emph{by} delineated by either \sQuote{"/"} or \sQuote{"::"}. The first argument need not be quoted, as it is converted internally if need be. The general form is \emph{from/to/by} or \emph{from::to::by}, where \emph{to} and \emph{by} are optional if the length.out arg is specified. The \code{from} and \code{to} elements of the string must be left-specified with respect to the standard \emph{CCYYMMDD HHMMSS} form. All dates-times specified will be set to either the earliest point (from) or the latest (to), given the level of specificity. For example \sQuote{1999} in the \emph{from} field would set the start to the beginning of 1999. The opposite occurs in the \emph{to} field. The level of detail in the request is interpretted as the level of detail in the result. The maximum detail of either \emph{from} or \emph{to} is the basis of the sequence, unless the optional \emph{by} element is specified, which will be covered later. To request a yearly series, it is only necessary to use \sQuote{"1999/2008"}. Alternately, one could request a monthly series (returned by default as class \code{yearmon}) with \sQuote{"199901/2008"} or \sQuote{"1999-01/2008"}, or even \sQuote{"1999/2008-01"}. As the level of granularity increases, so does the resultant sequence granularity - as does its length. Using the optional third \emph{by} field (the third delimited element to the string), will override the granularity intepretation and return the requested periodicity. The acceptable arguments include \code{Y} for years, \code{m} for months, \code{d} for days, \code{H} for hours, \code{M} for minutes and \code{S} for seconds. } \value{ A sequence or range of time-based objects. If \code{retclass} is \code{NULL}, the result is a named list of from, to, by and length.out. } \references{ International Organization for Standardization: ISO 8601 \url{https://www.iso.org}} \author{ Jeffrey A. Ryan } \seealso{ \code{\link{timeBased}}, \code{\link{xts}} } \examples{ timeBasedSeq('1999/2008') timeBasedSeq('199901/2008') timeBasedSeq('199901/2008/d') timeBasedSeq('20080101 0830',length=100) # 100 minutes timeBasedSeq('20080101 083000',length=100) # 100 seconds } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ utilities } xts/man/subset.xts.Rd0000644000176200001440000001312214522244666014266 0ustar liggesusers\name{[.xts} \Rdversion{1.1} \alias{[.xts} \alias{subset.xts} \alias{.subset.xts} \alias{.subset_xts} \title{ Extract Subsets of xts Objects } \description{ Details on efficient subsetting of \code{xts} objects for maximum performance and compatibility. } \usage{ \method{[}{xts}(x, i, j, drop = FALSE, which.i=FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ xts object } \item{i}{ the rows to extract. Numeric, timeBased or ISO-8601 style (see details) } \item{j}{ the columns to extract, numeric or by name } \item{drop}{ should dimension be dropped, if possible. See NOTE. } \item{which.i}{ return the \sQuote{i} values used for subsetting. No subset will be performed. } \item{\dots}{ additional arguments (unused) } } \details{ One of the primary motivations, and key points of differentiation of the time series class xts, is the ability to subset rows by specifying ISO-8601 compatible range strings. This allows for natural range-based time queries without requiring prior knowledge of the underlying time object used in construction. When a raw character vector is used for the \code{i} subset argument, it is processed as if it was ISO-8601 compliant. This means that it is parsed from left to right, according to the following specification: CCYYMMDD HH:MM:SS.ss+ A full description will be expanded from a left-specified truncated one. Additionally, one may specify range-based queries by simply supplying two time descriptions seperated by a forward slash: CCYYMMDD HH:MM:SS.ss+/CCYYMMDD HH:MM:SS.ss The algorithm to parse the above is \code{.parseISO8601} from the \pkg{xts} package. ISO-style subsetting, given a range type query, makes use of a custom binary search mechanism that allows for very fast subsetting as no linear search though the index is required. ISO-style character vectors may be longer than length one, allowing for multiple non-contiguous ranges to be selected in one subsetting call. If a character \emph{vector} representing time is used in place of numeric values, ISO-style queries, or timeBased objects, the above parsing will be carried out on each element of the i-vector. This overhead can be very costly. If the character approach is used when no ISO range querying is needed, it is recommended to wrap the \sQuote{i} character vector with the \code{I()} function call, to allow for more efficient internal processing. Alternately converting character vectors to POSIXct objects will provide the most performance efficiency. As \code{xts} uses POSIXct time representations of all user-level index classes internally, the fastest timeBased subsetting will always be from POSIXct objects, regardless of the \code{tclass} of the original object. All non-POSIXct time classes are converted to character first to preserve consistent TZ behavior. } \value{ An extraction of the original xts object. If \code{which.i} is TRUE, the corresponding integer \sQuote{i} values used to subset will be returned. } \note{ By design, drop=FALSE in the default case. This preserves the basic underlying type of \code{matrix} and the \code{dim()} to be non-NULL. This is different from both matrix and \code{zoo} behavior as \R uses \code{drop=TRUE}. Explicitly passing \code{drop=TRUE} may be required when performing certain matrix operations. } \references{ ISO 8601: Date elements and interchange formats - Information interchange - Representation of dates and time \url{https://www.iso.org} } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{xts}}, \code{\link{.parseISO8601}}, \code{\link{.index}} } \examples{ x <- xts(1:3, Sys.Date()+1:3) xx <- cbind(x,x) # drop=FALSE for xts, differs from zoo and matrix z <- as.zoo(xx) z/z[,1] m <- as.matrix(xx) m/m[,1] # this will fail with non-conformable arrays (both retain dim) tryCatch( xx/x[,1], error=function(e) print("need to set drop=TRUE") ) # correct way xx/xx[,1,drop=TRUE] # or less efficiently xx/drop(xx[,1]) # likewise xx/coredata(xx)[,1] x <- xts(1:1000, as.Date("2000-01-01")+1:1000) y <- xts(1:1000, as.POSIXct(format(as.Date("2000-01-01")+1:1000))) x.subset <- index(x)[1:20] x[x.subset] # by original index type system.time(x[x.subset]) x[as.character(x.subset)] # by character string. Beware! system.time(x[as.character(x.subset)]) # slow! system.time(x[I(as.character(x.subset))]) # wrapped with I(), faster! x['200001'] # January 2000 x['1999/2000'] # All of 2000 (note there is no need to use the exact start) x['1999/200001'] # January 2000 x['2000/200005'] # 2000-01 to 2000-05 x['2000/2000-04-01'] # through April 01, 2000 y['2000/2000-04-01'] # through April 01, 2000 (using POSIXct series) ### Time of day subsetting i <- 0:60000 focal_date <- as.numeric(as.POSIXct("2018-02-01", tz = "UTC")) x <- .xts(i, c(focal_date + i * 15), tz = "UTC", dimnames = list(NULL, "value")) # Select all observations between 9am and 15:59:59.99999: w1 <- x["T09/T15"] # or x["T9/T15"] head(w1) # timestring is of the form THH:MM:SS.ss/THH:MM:SS.ss # Select all observations between 13:00:00 and 13:59:59.9999 in two ways: y1 <- x["T13/T13"] head(y1) x[.indexhour(x) == 13] # Select all observations between 9:30am and 30 seconds, and 4.10pm: x["T09:30:30/T16:10"] # It is possible to subset time of day overnight. # e.g. This is useful for subsetting FX time series which trade 24 hours on week days # Select all observations between 23:50 and 00:15 the following day, in the xts time zone z <- x["T23:50/T00:14"] z["2018-02-10 12:00/"] # check the last day # Select all observations between 7pm and 8.30am the following day: z2 <- x["T19:00/T08:29:59"] head(z2); tail(z2) } \keyword{ utilities } xts/man/xts-package.Rd0000644000176200001440000000140514525744640014354 0ustar liggesusers\name{xts-package} \alias{xts-package} \docType{package} \title{ xts: extensible time-series } \description{ Extensible time series class and methods, extending and behaving like zoo. } \details{ Easily convert one of \R's many time-series (and non-time-series) classes to a true time-based object which inherits all of zoo's methods, while allowing for new time-based tools where appropriate. Additionally, one may use \pkg{xts} to create new objects which can contain arbitrary attributes named during creation as name=value pairs. } \author{ Jeffrey A. Ryan and Joshua M. Ulrich Maintainer: Joshua M. Ulrich } \keyword{ package } \seealso{ \code{\link{xts}} \code{\link{as.xts}} \code{\link{reclass}} \code{\link[zoo:zoo]{zoo}} } xts/man/xtsAttributes.Rd0000644000176200001440000000237214522244666015036 0ustar liggesusers\name{xtsAttributes} \alias{xtsAttributes} \alias{xtsAttributes<-} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract and Replace xts Attributes } \description{ Extract and replace non-core \code{xts} attributes. } \usage{ xtsAttributes(x, user=NULL) xtsAttributes(x) <- value } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an xts object } \item{user}{ logical; should user-defined attributes be returned? The default of \code{NULL} returns all \code{xts} attributes. } \item{value}{ a list of new name=value attributes } } \details{ Since \code{xts} objects are S3 objects with special attributes, a method is necessary to properly assign and view the user-added attributes. A call to \code{attributes} from the \pkg{base} package will return all attributes, including those specific to the \code{xts} class. } \value{ A named list of user settable attributes. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{attributes}}} \examples{ x <- xts(matrix(1:(9*6),nc=6), order.by=as.Date(13000,origin="1970-01-01")+1:9, a1='my attribute') xtsAttributes(x) xtsAttributes(x) <- list(a2=2020) xtsAttributes(x) xtsAttributes(x) <- list(a1=NULL) xtsAttributes(x) } \keyword{ utilities } xts/man/diff.Rd0000644000176200001440000000533614522244665013063 0ustar liggesusers\name{diff.xts} \alias{diff.xts} \alias{lag.xts} \alias{lagts.xts} \title{ Lags and Differences of xts Objects } \description{ Methods for computing lags and differences on \code{xts} objects. This matches most of the functionality of \pkg{zoo} methods, with some default argument changes. } \usage{ \method{lag}{xts}(x, k = 1, na.pad = TRUE, ...) %\method{lagts}{xts}(x, k = 1, na.pad = TRUE, ...) % \method{diff}{xts}(x, lag = 1, differences = 1, arithmetic = TRUE, log = FALSE, na.pad = TRUE, ...) } \arguments{ \item{x}{ an \code{xts} object } \item{k}{ period to lag over } \item{lag}{ period to difference over } \item{differences}{ order of differencing } \item{arithmetic}{ should arithmetic or geometric differencing be used } \item{log}{ should (geometric) log differences be returned } \item{na.pad}{ pad vector back to original size } \item{\dots}{ additional arguments } } \details{ The primary motivation for having methods specific to \code{xts} was to make use of faster C-level code within xts. Additionally, it was decided that \code{lag}'s default behavior should match the common time-series interpretation of that operator --- specifically that a value at time \sQuote{t} should be the value at time \sQuote{t-1} for a positive lag. This is different than \code{lag.zoo} as well as \code{lag.ts}. Another notable difference is that \code{na.pad} is set to TRUE by default, to better reflect the transformation visually and within functions requiring positional matching of data. Backwards compatability with zoo can be achieved by setting \code{options(xts.compat.zoo.lag=TRUE)}. This will change the defaults of lag.xts to k=-1 and na.pad=FALSE. %With the introduction of the new \code{lagts} generic in zoo, lag.xts %will begin the process of reverting to zoo-behavior, i.e. negative %k values will indicate positive lags. The current xts behavior will %then move to lagts. The process by which this will happen will be %a warning displayed in any lag.xts call at first, calling attention %to the upcoming change. The new xts method for lagts will be be made available %as of 0.8-1. Warning messages of the change will follow in subsequent releases. } \value{ An \code{xts} object reflected the desired lag and/or differencing. } \references{ \url{https://en.wikipedia.org/wiki/Lag } } \author{ Jeffrey A. Ryan } \examples{ x <- xts(1:10, Sys.Date()+1:10) lag(x) # currently using xts-style positive k %lagts(x) # same as original lag.xts, to allow for lag.xts to revert to R lag consistency lag(x, k=2) %lagts(x, k=2) lag(x, k=-1, na.pad=FALSE) # matches lag.zoo(x, k=1) diff(x) diff(x, lag=1) diff(x, diff=2) diff(diff(x)) } \keyword{ manip }% __ONLY ONE__ keyword per line \keyword{ chron }% __ONLY ONE__ keyword per line xts/man/CLASS.Rd0000644000176200001440000000160614522244665013014 0ustar liggesusers\name{CLASS} \alias{CLASS} \alias{CLASS<-} \title{ Extract and Set .CLASS Attribute } \description{ Simple extraction and replacement function to access \code{xts} .CLASS attribute. The .CLASS attribute is used by \code{reclass} to transform an \code{xts} object back to its original class. } \usage{ CLASS(x) CLASS(x) <- value } \arguments{ \item{x}{ an xts object } \item{value}{ the new .CLASS value to assign } } \details{ It is not recommended that CLASS be called in daily use. While it may be possible to coerce objects to other classes than originally derived from, there is little, if any, chance that the \code{reclass} function will perform as expected. It is best to use the traditional \code{as} methods. } \value{ Called for its side-effect of changing the .CLASS attribute } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{as.xts}},\code{\link{reclass}} } \keyword{ utilities } xts/man/isOrdered.Rd0000644000176200001440000000157714522244665014076 0ustar liggesusers\name{isOrdered} \alias{isOrdered} \title{ Check If A Vector Is Ordered } \description{ Performs check to determine if a vector is strictly increasing, strictly decreasing, not decreasing, or not increasing. } \usage{ isOrdered(x, increasing = TRUE, strictly = TRUE) } \arguments{ \item{x}{ a numeric vector } \item{increasing}{ test for increasing/decreasing values } \item{strictly}{ are duplicates OK } } \details{ Designed for internal use with \pkg{xts}, this provides highly optimized tests for ordering. } \value{ Logical } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{is.unsorted}} } \examples{ # strictly increasing isOrdered(1:10, increasing=TRUE) isOrdered(1:10, increasing=FALSE) isOrdered(c(1,1:10), increasing=TRUE) isOrdered(c(1,1:10), increasing=TRUE, strictly=FALSE) # decreasing isOrdered(10:1, increasing=TRUE) isOrdered(10:1, increasing=FALSE) } \keyword{ misc } xts/man/ndays.Rd0000644000176200001440000000214614522244665013265 0ustar liggesusers\name{ndays} \alias{nseconds} \alias{nminutes} \alias{nhours} \alias{ndays} \alias{nweeks} \alias{nmonths} \alias{nquarters} \alias{nyears} \title{ Number of Periods in Data } \description{ Calculate the number of specified periods in a given time series like data object. } \usage{ nseconds(x) nminutes(x) nhours(x) ndays(x) nweeks(x) nmonths(x) nquarters(x) nyears(x) } \arguments{ \item{x}{ A time-based object } } \details{ Essentially a wrapper to \code{endpoints} with the appropriate period specified; the resulting value derived from counting the endpoints As a compromise between simplicity and accuracy, the results will always round up to the nearest complete period. So n**** - 1 will return the completed periods. For finer grain detail one should call a higher frequency n**** function. An alternative summary can be found with \code{periodicity} and \code{unclass(periodicity(x))}. } \value{ The number of observations for the period type specified } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}} } \examples{ \dontrun{ getSymbols("QQQQ") ndays(QQQQ) nweeks(QQQQ) } } \keyword{ utilities } xts/man/merge.Rd0000644000176200001440000000711514522244665013247 0ustar liggesusers\name{merge.xts} \alias{merge.xts} \alias{cbind.xts} \title{ Merge xts Objects } \description{ Used to perform merge operation on \code{xts} objects by \emph{time} (index). Given the inherent ordered nature of \code{xts} time-series, a merge-join style merge allows for optimally efficient joins. } \usage{ \method{merge}{xts}(..., all = TRUE, fill = NA, suffixes = NULL, join = "outer", retside = TRUE, retclass = "xts", tzone = NULL, drop=NULL, check.names=NULL) } \arguments{ \item{\dots}{ one or more xts objects, or objects coercible to class xts } \item{all}{ a logical vector indicating merge type } \item{fill}{ values to be used for missing elements } \item{suffixes}{ to be added to merged column names } \item{join}{ type of database join } \item{retside}{ which side of the merged object should be returned (2-case only) } \item{retclass}{ object to return } \item{tzone}{ time zone of merged object } \item{drop}{ not currently used } \item{check.names}{ not currently used } } \details{ This is an xts method compatible with merge.zoo, as xts extends zoo. That documentation should also be referenced. Difference are noted where applicable. Implemented almost entirely in custom C-level code, it is possible using either the \code{all} argument or the \code{join} argument to implement all common database join operations along the to-be-merged objects time-index: \sQuote{outer} (full outer - all rows), \sQuote{inner} (only rows with common indexes), \sQuote{left} (all rows in the left object, and those that match in the right), and \sQuote{right} (all rows in the right object, and those that match in the left). The above join types can also be expressed as a vector of logical values passed to \code{all}. c(TRUE,TRUE) or TRUE for \sQuote{join="outer"}, c(FALSE,FALSE) or FALSE for \sQuote{join="inner"}, c(TRUE, FALSE) for \sQuote{join="left"}, and c(FALSE,TRUE) for \sQuote{join="right"}. Note that the \code{all} and \code{join} arguments imply a two case scenario. For merging more than two objects, they will simply fall back to a full outer or full inner join, depending on the first position of all, as left and right can be ambiguous with respect to sides. To do something along the lines of merge.zoo's method of joining based on an all argument of the same length of the arguments to join, see the example. The resultant object will have the timezone of the leftmost argument if available. Use \code{tzone} to override. If \code{retclass} is \code{NULL}, the joined objects will be split and reassigned silently back to the original environment they are called from. This is for backward compatibility with zoo, though unused by xts. If \code{retclass} is \code{FALSE} the object will be stripped of its class attribute. This is for internal use. } \value{ A new \code{xts} object containing the appropriate elements of the objects passed in to be merged. } \references{ Merge Join Discussion: \url{https://blogs.msdn.microsoft.com/craigfr/2006/08/03/merge-join/} } \author{ Jeffrey A. Ryan } \note{ This is a highly optimized merge, specifically designed for ordered data. The only supported merging is based on the underlying time index. } \examples{ (x <- xts(4:10, Sys.Date()+4:10)) (y <- xts(1:6, Sys.Date()+1:6)) merge(x,y) merge(x,y, join='inner') merge(x,y, join='left') merge(x,y, join='right') merge.zoo(zoo(x),zoo(y),zoo(x), all=c(TRUE, FALSE, TRUE)) merge(merge(x,x),y,join='left')[,c(1,3,2)] # zero-width objects (only index values) can be used xi <- xts( , index(x)) merge(y, xi) } \keyword{ manip } \keyword{ utilities } xts/man/as.xts.Rd0000644000176200001440000000676614522244665013403 0ustar liggesusers\name{as.xts} \alias{as.xts} \alias{xtsible} \alias{use.xts} \alias{try.xts} \alias{use.reclass} \alias{Reclass} \alias{reclass} \title{ Convert Object To And From Class xts } \description{ Conversion functions to coerce data objects of arbitrary classes to class \code{xts} and back, without losing any attributes of the original format. } \usage{ as.xts(x, ...) xtsible(x) Reclass(x) try.xts(x, ..., error = TRUE) reclass(x, match.to, error = FALSE, ...) } \arguments{ \item{x}{ data object to convert. See details for supported types } \item{match.to}{ \code{xts} object whose attributes will be passed to \code{x}} \item{error}{ error handling option. See Details. } \item{\dots}{ additional parameters or attributes } } \details{ A simple and reliable way to convert many different objects into a uniform format for use within \R. It is possible with a call to \code{as.xts} to convert objects of class \code{timeSeries}, \code{ts}, \code{irts}, \code{matrix}, \code{data.frame}, and \code{zoo}. \code{xtsible} safely checks whether an object can be converted to an \code{xts} object; returning TRUE on success and FALSE otherwise. The help file \code{as.xts.methods} lists all available xts methods and arguments specific to each coercible type. Additional name=value pairs may be passed to the function to be added to the new object. A special print.xts method will assure that the attributes are hidden from view, but will be available via \R's standard \code{attr} function, as well as the \code{xtsAttributes} function. The returned object will preserve all relevant attribute/slot data within itself, allowing for temporary conversion to use zoo and xts compatible methods. A call to \code{reclass} returns the object to its original class, with all original attributes intact - unless otherwise changed. It should be obvious, but any attributes added via the \dots argument will not be carried back to the original data object, as there would be no available storage slot/attribute. \code{Reclass} is designed for top-level use, where it is desirable to have the object returned from an arbitrary function in the same class as the object passed in. Most functions within \R are not designed to return objects matching the original object's class. While this tool is highly experimental at present, it attempts to handle conversion and reconversion transparently. The caveats are that the original object must be coercible to \code{xts}, the returned object must be of the same row length as the original object, and that the object to reconvert to is the first argument to the function being wrapped. \code{try.xts} and \code{reclass} are functions that enable external developers access to the reclassing tools within \pkg{xts} to help speed development of time-aware functions, as well as provide a more robust and seemless end-user experience, regardless of the end-user's choice of data-classes. The \code{error} argument to try.xts accepts a logical value, indicating where an error should be thrown, a character string allowing for custom error messages to be displayed, or a function of the form \code{f(x, ...)}, to be called upon construction error. See the accompanying vignette for more details on the above usage and the package in general. } \value{ An S3 object of class \code{xts}. In the case of \code{Reclass} and \code{reclass}, the object returned will be of the original class as identified by \code{CLASS}. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{xts}},\code{\link{as.xts.methods}} } \keyword{ utilities } xts/man/period.max.Rd0000644000176200001440000000222614522244665014214 0ustar liggesusers\name{period.max} \alias{period.max} \title{ Calculate Max By Period } \description{ Calculate a maximum for each period of INDEX. Essentially a rolling application of maximum over a series of non-overlapping sections. } \usage{ period.max(x, INDEX) } \arguments{ \item{x}{ a univariate data object } \item{INDEX}{ a numeric vector of endpoints to calculate maximum on } } \details{ Used to calculate a maximum per period given an arbitrary index of sections to be calculated over. This is an optimized function for maximum. There are additional optimized versions for min, sum, and prod. For xts-coercible objects, an appropriate INDEX can be derived from a call to 'endpoints'. } \value{ An xts or zoo object of maximums, indexed by the period endpoints. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}}, \code{\link{period.sum}}, \code{\link{period.min}}, \code{\link{period.prod}} } \examples{ period.max(c(1,1,4,2,2,6,7,8,-1,20),c(0,3,5,8,10)) data(sample_matrix) period.max(sample_matrix[,1],endpoints(sample_matrix)) period.max(as.xts(sample_matrix)[,1],endpoints(sample_matrix)) } \keyword{ utilities }% __ONLY ONE__ keyword per line xts/man/addEventLines.Rd0000644000176200001440000000254714522244665014701 0ustar liggesusers\name{addEventLines} \alias{addEventLines} \title{Add vertical lines to an existing xts plot} \usage{ addEventLines(events, main = "", on = 0, lty = 1, lwd = 1, col = 1, ...) } \arguments{ \item{events}{xts object of events and their associated labels. It is assumed that the first column of \code{events} is the event description/label.} \item{main}{main title for a new panel if drawn.} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}. The default, \code{on=0}, will add to the active panel. The active panel is defined as the panel on which the most recent action was performed. Note that only the first element of \code{on} is checked for the default behavior to add to the last active panel.} \item{lty}{set the line type, same as in \code{\link{par}}.} \item{lwd}{set the line width, same as in \code{\link{par}}.} \item{col}{color palette to use, set by default to rational choices.} \item{\dots}{any other passthrough parameters to \code{\link{text}} to control how the event labels are drawn} } \description{ Add vertical lines and labels to an existing xts plot } \author{ Ross Bennett } \examples{ \dontrun{ library(xts) data(sample_matrix) sample.xts <- as.xts(sample_matrix) events <- xts(letters[1:3], as.Date(c("2007-01-12", "2007-04-22", "2007-06-13"))) plot(sample.xts[,4]) addEventLines(events, srt=90, pos=2) } } xts/man/coredata.xts.Rd0000644000176200001440000000334214522244665014545 0ustar liggesusers\name{coredata.xts} \alias{coredata.xts} \alias{xcoredata} \alias{xcoredata<-} \title{ Extract/Replace Core Data of an xts Object } \description{ Mechanism to extract and replace the core data of an \code{xts} object. } \usage{ \method{coredata}{xts}(x, fmt=FALSE, ...) xcoredata(x,...) xcoredata(x) <- value } \arguments{ \item{x}{ an \code{xts} object } \item{fmt}{ should the rownames be formated in a non-standard way } \item{value}{ non-core attributes to assign } \item{\dots}{ further arguments [unused] } } \details{ Extract coredata of an \code{xts} object - removing all attributes except \code{dim} and \code{dimnames} and returning a matrix object with rownames converted from the index of the \code{xts} object. The \code{fmt} argument, if TRUE, allows the internal index formatting specified by the user to be used. Alternatively, it may be a valid formatting string to be passed to \code{format}. Setting to FALSE will return the row names by simply coercing the index class to a character string in the default manner. \code{xcoredata} is the functional complement to \code{coredata}, returning all of the attributes normally removed by \code{coredata}. Its purpose, along with the replacement function \code{xcoredata<-} is primarily for use by developers using \pkg{xts} to allow for internal replacement of values removed during use of non xts-aware functions. } \value{ Returns either a matrix object for coredata, or a list of named attributes. The replacement functions are called for their side-effects. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link[zoo:zoo]{coredata}}, \code{\link{xtsAttributes}} } \examples{ data(sample_matrix) x <- as.xts(sample_matrix, myattr=100) coredata(x) xcoredata(x) } \keyword{ utilities } xts/man/parseISO8601.Rd0000644000176200001440000000574014522244665014156 0ustar liggesusers\name{.parseISO8601} \alias{ISO8601} \Rdversion{1.1} \alias{parseISO8601} \alias{makeISO8601} \alias{.parseISO8601} \alias{.makeISO8601} \title{ Internal ISO 8601:2004(e) Time Parser } \description{ This function is used internally in the subsetting mechanism of xts. The function is unexported, though documented for use with xts subsetting. } \usage{ .parseISO8601(x, start, end, tz="") .makeISO8601(x) } \arguments{ \item{x}{ For .parseISO8601(x), a character string conforming to the ISO 8601:2004(e) rules. For .makeISO8601(x), \code{x} should be a time-like object with \code{start} and \code{end} methods. } \item{start}{ lower constraint on range } \item{end}{ upper constraint of range } \item{tz}{ timezone (tzone) to use internally } } \details{ This function replicates most of the ISO standard for expressing time and time-based ranges in a universally accepted way. The best documentation is now the official ISO page as well as the Wikipedia entry for ISO 8601:2004. The basic idea is to create the endpoints of a range, given a string representation. These endpoints are aligned in POSIXct time to the zero second of the day at the beginning, and the 59.9999th second of the 59th minute of the 23rd hour of the final day. For dates prior to the epoch (1970-01-01) the ending time is aligned to the 59.0000 second. This is due to a bug/feature in the \R implementation of asPOSIXct and mktime0 at the C-source level. This limits the precision of ranges prior to 1970 to 1 minute granularity with the current \pkg{xts} workaround. Recurring times over multiple days may be specified using the T notation. See the examples for details. } \value{ A list of length two, with an entry named \sQuote{first.time} and one names \sQuote{last.time}. For .makeISO8601, a character vector of length one describing the ISO-style format for a given time-based object. } \references{ \url{https://en.wikipedia.org/wiki/ISO_8601}\cr \url{https://www.iso.org/iso-8601-date-and-time-format.html} } \author{ Jeffrey A. Ryan } \note{ There is no checking done to test for a properly constructed ISO format string. This must be correctly entered by the user, lest bad things may happen. When using durations, it is important to note that the time of the duration specified is not necessarily the same as the realized periods that may be returned when applied to an irregular time series. This is not a bug, rather it is a standards and implementation gotcha. } \examples{ # the start and end of 2000 .parseISO8601('2000') # the start of 2000 and end of 2001 .parseISO8601('2000/2001') # May 1, 2000 to Dec 31, 2001 .parseISO8601('2000-05/2001') # May 1, 2000 to end of Feb 2001 .parseISO8601('2000-05/2001-02') # Jan 1, 2000 to Feb 29, 2000; note the truncated time on the LHS .parseISO8601('2000-01/02') # 8:30 to 15:00 (used in xts subsetting to extract recurring times) .parseISO8601('T08:30/T15:00') } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ utilities } xts/man/split.Rd0000644000176200001440000000267214522244666013307 0ustar liggesusers\name{split.xts} \Rdversion{1.1} \alias{split.xts} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Divide into Groups by Time } \description{ Creates a list of xts objects split along time periods. } \usage{ \method{split}{xts}(x, f = "months", drop=FALSE, k = 1, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an xts object } \item{f}{ a 'character' vector describing the period to split by } \item{drop}{ ignored by split.xts } \item{k}{ number of periods to aggregate into each split. See Details. } \item{\dots}{ further args to non-xts method } } \details{ A quick way to break up a large xts object by standard time periods; e.g. 'months', 'quarters', etc. \code{endpoints} is used to find the start and end of each period (or k-periods). See that function for valid arguments. If \code{f} is not a character vector, the NextMethod is called, which would in turn dispatch to the split.zoo method. } \value{ A list of xts objects. } \author{ Jeffrey A. Ryan } \note{ \code{aggregate.zoo} would be more flexible, though not as fast for xts objects. } \seealso{ \code{\link{endpoints}}, \code{\link[zoo]{split.zoo}}, \code{\link[zoo]{aggregate.zoo}} } \examples{ data(sample_matrix) x <- as.xts(sample_matrix) split(x) split(x, f="weeks") split(x, f="weeks", k=4) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ utilities } xts/man/plot.xts.Rd0000644000176200001440000001377414525744640013754 0ustar liggesusers\name{plot.xts} \alias{plot.xts} \alias{lines.xts} \alias{points.xts} \title{Plotting xts Objects} \usage{ \method{plot}{xts}(x, y = NULL, ..., subset = "", panels = NULL, multi.panel = FALSE, col = 1:8, up.col = NULL, dn.col = NULL, bg = "#FFFFFF", type = "l", lty = 1, lwd = 2, lend = 1, main = deparse(substitute(x)), main.timespan = TRUE, observation.based = FALSE, log = FALSE, ylim = NULL, yaxis.same = TRUE, yaxis.left = TRUE, yaxis.right = TRUE, yaxis.ticks = 5, major.ticks = "auto", minor.ticks = NULL, grid.ticks.on = "auto", grid.ticks.lwd = 1, grid.ticks.lty = 1, grid.col = "darkgray", labels.col = "#333333", format.labels = TRUE, grid2 = "#F5F5F5", legend.loc = NULL, extend.xaxis = FALSE) \method{lines}{xts}(x, ..., main = "", on = 0, col = NULL, type = "l", lty = 1, lwd = 1, pch = 1) \method{points}{xts}(x, ..., main = "", on = 0, col = NULL, pch = 1) } \arguments{ \item{x}{xts object} \item{y}{NULL, not used} \item{\dots}{any passthrough graphical arguments for \code{lines} and \code{points}} \item{subset}{character vector of length one of the subset range using subsetting as in \code{\link{xts}}} \item{panels}{character vector of expressions to plot as panels} \item{multi.panel}{TRUE/FALSE or an integer less than or equal to the number of columns in the data set. If TRUE, each column of the data is plotted in a separate panel. For example, if \code{multi.panel = 2}, then the data will be plotted in groups of 2 columns and each group is plotted in a separate panel.} \item{col}{color palette to use, set by default to rational choices} \item{up.col}{color for positive bars if \code{type="h"}} \item{dn.col}{color for negative bars if \code{type="h"}} \item{bg}{background color of plotting area, same as in \code{\link{par}}} \item{type}{the type of plot to be drawn, same as in \code{\link{plot}}} \item{lty}{set the line type, same as in \code{\link{par}}} \item{lwd}{set the line width, same as in \code{\link{par}}} \item{lend}{set the line end style, same as in \code{\link{par}}} \item{main}{main title} \item{main.timespan}{include the timespan of the series on the plot? (default \code{TRUE})} \item{observation.based}{TRUE/FALSE (default FALSE). If \code{TRUE}, the x-axis is drawn based on observations in the data. If \code{FALSE}, the x-axis is drawn based on the time index of the data.} \item{log}{TRUE/FALSE (default FALSE). If \code{TRUE}, the y-axis is drawn in log-scale} \item{ylim}{the range of the y axis} \item{yaxis.same}{TRUE/FALSE. If TRUE, the y axis is drawn with the same ylim for multiple panels} \item{yaxis.left}{if TRUE, draws the y axis on the left} \item{yaxis.right}{if TRUE, draws the y axis on the right} \item{yaxis.ticks}{desired number of y axis grid lines. The actual number of grid lines is determined by the \code{n} argument to \code{\link{pretty}}.} \item{major.ticks}{period that specifies where tick marks and labels will be drawn on the x-axis. See Details for possible values.} \item{minor.ticks}{period that specifies where minor ticks on will be drawn on the x-axis. If \code{NULL}, minor ticks are not drawn. See Details for possible values.} \item{grid.ticks.on}{period that specifies where vertical grid lines will be drawn. See Details for possible values.} \item{grid.ticks.lwd}{line width of the grid} \item{grid.ticks.lty}{line type of the grid} \item{grid.col}{color of the grid} \item{labels.col}{color of the axis labels} \item{format.labels}{label format to draw lower frequency x-axis ticks and labels passed to \code{\link{axTicksByTime}}} \item{grid2}{color for secondary x axis grid} \item{legend.loc}{places a legend into one of nine locations on the chart: bottomright, bottom, bottomleft, left, topleft, top, topright, right, or center. Default NULL does not draw a legend.} \item{pch}{the plotting character to use, same as in \code{\link{par}}.} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}. The default, \code{on=0}, will add to the active panel. The active panel is defined as the panel on which the most recent action was performed. Note that only the first element of \code{on} is checked for the default behavior to add to the last active panel.} \item{extend.xaxis}{TRUE/FALSE (default FALSE). If TRUE, extend the x-axis before and/or after the plot's existing time index range, so all of of the time index values of the new series are included in the plot.} } \details{ Possible values for arguments \code{major.ticks}, \code{minor.ticks}, and \code{grid.ticks.on} include \sQuote{auto}, \sQuote{minute}, \sQuote{hours}, \sQuote{days}, \sQuote{weeks}, \sQuote{months}, \sQuote{quarters}, and \sQuote{years}. The default is \sQuote{auto}, which attempts to determine sensible locations from the periodicity and locations of observations. The other values are based on the possible values for the \code{ticks.on} argument of \code{\link{axTicksByTime}}. } \description{ Plotting for xts objects. } \author{ Ross Bennett } \references{ based on \code{chart_Series} in the \code{quantmod} package by Jeffrey A. Ryan } \seealso{ \code{\link{addSeries}}, \code{\link{addPanel}} } \examples{ \dontrun{ data(sample_matrix) sample.xts <- as.xts(sample_matrix) # plot the Close plot(sample.xts[,"Close"]) # plot a subset of the data plot(sample.xts[,"Close"], subset="2007-04-01/2007-06-31") # function to compute simple returns simple.ret <- function(x, col.name){ x[,col.name] / lag(x[,col.name]) - 1 } # plot the close and add a panel with the simple returns plot(sample.xts[,"Close"]) R <- simple.ret(sample.xts, "Close") lines(R, type="h", on=NA) # add the 50 period simple moving average to panel 1 of the plot library(TTR) lines(SMA(sample.xts[,"Close"], n = 50), on=1, col="blue") # add month end points to the chart points(sample.xts[endpoints(sample.xts[,"Close"], on = "months"), "Close"], col="red", pch=17, on=1) # add legend to panel 1 addLegend("topright", on=1, legend.names = c("Close", "SMA(50)"), lty=c(1, 1), lwd=c(2, 1), col=c("black", "blue", "red")) } } xts/man/align.time.Rd0000644000176200001440000000256314522244665014201 0ustar liggesusers\name{align.time} \Rdversion{1.1} \alias{align.time} \alias{align.time.xts} \alias{adj.time} \alias{shift.time} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Align seconds, minutes, and hours to beginning of next period. } \description{ Change timestamps to the start of the next period, specified in multiples of seconds. } \usage{ align.time(x, ...) \method{align.time}{xts}(x, n=60, \dots) shift.time(x, n=60, ...) adj.time(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ object to align } \item{n}{ number of seconds to adjust by } \item{\dots}{ additional arguments. See details. } } \details{ This function is an S3 generic. The result is to round up to the next period determined by \code{n modulo x}. } \value{ A new object of class(x) } \author{ Jeffrey A. Ryan with input from Brian Peterson } \seealso{ \code{\link{to.period}} } \examples{ x <- Sys.time() + 1:1000 # every 10 seconds align.time(x, 10) # align to next whole minute align.time(x, 60) # align to next whole 10 min interval align.time(x, 10 * 60) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ chron }% __ONLY ONE__ keyword per line \keyword{ manip }% __ONLY ONE__ keyword per line \keyword{ ts }% __ONLY ONE__ keyword per line \keyword{ misc }% __ONLY ONE__ keyword per line xts/man/window.xts.Rd0000644000176200001440000000464514522244666014302 0ustar liggesusers\name{window.xts} \Rdversion{1.1} \alias{window.xts} \title{Extract time windows from an \code{xts} series} \description{ Method for extracting time windows from \code{xts} objects. } \usage{ \method{window}{xts}(x, index. = NULL, start = NULL, end = NULL, \dots) } \arguments{ \item{x}{an object.} \item{index.}{a user defined time index. This defaults to the \code{xts} index for the series via \code{.index(x)}. When supplied, this is typically a subset of the dates in the full series.\cr The \code{index.} must be a set of dates that are convertible to \code{POSIXct}. If you want fast lookups, then \code{index.} should be sorted and of class \code{POSIXct}.\cr If an unsorted \code{index.} is passed in, \code{window} will sort it.} \item{start}{a start time. Extract \code{xts} rows where \code{index. >= start}. \code{start} may be any class that is convertible to \code{POSIXct} such as a character variable in the format \sQuote{YYYY-MM-DD}.\cr If \code{start} is \code{NULL} then all \code{index.} dates are matched.} \item{end}{an end time. Extract \code{xts} rows where \code{index. <= end}. \code{end} must be convertible to \code{POSIXct}. If \code{end} is \code{NULL} then all \code{index.} dates are matched.} \item{\dots}{currently not used.} } \value{ The matching time window is extracted. } \details{ The point of having \code{window} in addition to the regular subset function is to have a fast way of extracting time ranges from an \code{xts} series. In particular, this method will convert \code{start} and \code{end} to \code{POSIXct} then do a binary lookup on the internal \code{xts} index to quickly return a range of matching dates. With a user supplied \code{index.}, a similarly fast invocation of \code{findInterval} is used so that large sets of sorted dates can be retrieved quickly. } \author{ Corwin Joy } \seealso{ \code{\link{subset.xts}}, \code{\link[base]{findInterval}}, \code{\link{xts}} } \examples{ ## xts example x.date <- as.Date(paste(2003, rep(1:4, 4:1), seq(1,19,2), sep = "-")) x <- xts(matrix(rnorm(20), ncol = 2), x.date) x window(x, start = "2003-02-01", end = "2003-03-01") 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)]) ## Assign to subset window(x, index = x.date[c(4, 8, 10)]) <- matrix(1:6, ncol = 2) x } \keyword{ts} xts/man/firstof.Rd0000644000176200001440000000171314522244665013622 0ustar liggesusers\name{firstof} \alias{firstof} \alias{lastof} \title{ Create a POSIXct Object } \description{ Enable fast creation of time stamps corresponding to the first or last observation in a specified time period. } \usage{ firstof(year = 1970, month = 1, day = 1, hour = 0, min = 0, sec = 0, tz = "") } %- maybe also 'usage' for other objects documented here. \arguments{ \item{year,month,day}{ numerical values to specify a day } \item{hour,min,sec}{ numerical vaues to specify time within a day } \item{tz}{ timezone used for conversion } } \details{ A wrapper to the \R function ISOdatetime with defaults corresponding to the first or last possible time in a given period. } \value{ An object of class POSIXct. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{ISOdatetime}} } \examples{ firstof(2000) firstof(2005,01,01) lastof(2007) lastof(2007,10) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ utilities } xts/man/tformat.Rd0000644000176200001440000000364114522244666013625 0ustar liggesusers\name{tformat} \alias{tformat} \alias{tformat<-} \alias{tformat.xts} \alias{tformat<-.xts} \alias{indexFormat} \alias{indexFormat<-} \title{ Get or Replace the Format of an xts Object's Index } \description{ Generic functions to get or replace the format that determines how an xts object's index is printed. } \usage{ tformat(x, \dots) tformat(x) <- value \method{tformat}{xts}(x, \dots) \method{tformat}{xts}(x) <- value ##### The functions below are DEPRECATED ##### indexFormat(x) indexFormat(x) <- value } \arguments{ \item{x}{ an \code{xts} object } \item{value}{ new index format string (see Details for valid values) } \item{\dots}{ arguments passed to other methods } } \details{ Valid values for the \code{value} argument are the same as specified in the \emph{Details} section of \code{\link{strptime}}. An xts object's \code{tformat} is \code{NULL} by default, so the index will be formatted according to its \code{\link{tclass}} (e.g. \code{Date}, \code{POSIXct}, \code{timeDate}, \code{yearmon}, etc.). \code{tformat} only changes how the index is \emph{printed} and how the row names are formatted when xts objects are converted to other classes (e.g. \code{matrix} or \code{data.frame}. It does not affect the internal index in any way. } \value{ A vector containing the format for the object's index. } \note{ Both \code{indexFormat} and \code{indexFormat<-} are deprecated in favor of \code{tformat} and \code{tformat<-}, respectively. } \seealso{ \code{\link{index}} has more information on the xts index, \code{\link{tclass}} details how \pkg{xts} handles the class of the index, \code{\link{tzone}} has more information about the index timezone settings. } \author{ Jeffrey A. Ryan } \examples{ x <- timeBasedSeq('2010-01-01/2010-01-02 12:00') x <- xts(seq_along(x), x) # set a custom index format head(x) tformat(x) <- "\%Y-\%b-\%d \%H:\%M:\%OS3" head(x) } \keyword{ts} \keyword{utilities} xts/man/make.index.unique.Rd0000644000176200001440000000351714522244665015502 0ustar liggesusers\name{make.index.unique} \alias{make.index.unique} \alias{make.time.unique} \alias{is.index.unique} \alias{is.time.unique} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Force Time Values To Be Unique } \description{ A generic function to force sorted time vectors to be unique. Useful for high-frequency time-series where original time-stamps may have identical values. For the case of xts objects, the default \code{eps} is set to ten microseconds. In practice this advances each subsequent identical time by \code{eps} over the previous (possibly also advanced) value. } \usage{ make.index.unique(x, eps = 1e-06, drop=FALSE, fromLast=FALSE, ...) make.time.unique(x, eps = 1e-06, drop=FALSE, fromLast=FALSE, ...) } \arguments{ \item{x}{ An xts object, or POSIXct vector. } \item{eps}{ value to add to force uniqueness. } \item{drop}{ drop duplicates instead of adjusting by \code{eps} } \item{fromLast}{ if drop=TRUE, fromLast controls which duplicated times are dropped. If fromLast=FALSE, the earliest observation with an identical timestamp is kept with subsequent observations dropped. } \item{\dots}{ unused } } \details{ The returned time-series object will have new time-stamps so that \code{isOrdered( .index(x) )} evaluates to TRUE. } \value{ A modified version of x. } \author{ Jeffrey A. Ryan } \note{ Incoming values must be pre-sorted, and no check is done to make sure that this is the case. If the index values are of storage.mode \sQuote{integer}, they will be coerced to \sQuote{double} if drop=FALSE. } \seealso{ \code{\link{align.time}} } \examples{ ds <- options(digits.secs=6) # so we can see the change x <- xts(1:10, as.POSIXct("2011-01-21") + c(1,1,1,2:8)/1e3) x make.index.unique(x) options(ds) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ ts } xts/man/first.Rd0000644000176200001440000000640014522244665013273 0ustar liggesusers\name{first} \alias{first} \alias{first.default} \alias{first.xts} \alias{last} \alias{last.default} \alias{last.xts} \title{ Return First or Last n Elements of A Data Object } \description{ A generic function to return the first or last elements or rows of a vector or two-dimensional data object. A more advanced subsetting is available for zoo objects with indexes inheriting from POSIXt or Date classes. } \usage{ first(x,...) last(x,...) \method{first}{default}(x,n=1,keep=FALSE,...) \method{last}{default}(x,n=1,keep=FALSE,...) \method{first}{xts}(x,n=1,keep=FALSE,...) \method{last}{xts}(x,n=1,keep=FALSE,...) } \arguments{ \item{x}{ 1 or 2 dimensional data object } \item{n}{ number of periods to return } \item{keep}{ should removed values be kept? } \item{\dots}{ additional args - unused } } \details{ Provides the ability to identify the first or last \code{n} rows or observations of a data set. The generic method behaves much like \code{head} and \code{tail} from \pkg{base}, except by default only the \emph{first} or \emph{last} observation will be returned. The more useful method for the xts class allows for time based subsetting, given an xtsible object. \code{n} may be either a numeric value, indicating the number of observations to return - forward from \code{first}, or backwards from \code{last}, or it may be a character string describing the number and type of periods to return. \code{n} may be positive or negative, in either numeric or character contexts. When positive it will return the result expected - e.g. \code{last(X,'1 month')} will return the last month's data. If negative, all data will be returned \emph{except} for the last month. It is important to note that this is not the same as calling \code{first(X,'1 month')} or \code{first(X,'-1 month')}. All 4 variations return different subsets of data and have distinct purposes. If \code{n} is a character string, it must be of the form \sQuote{n period.type} or \sQuote{period.type}, where \code{n} is a numeric value (defaults to 1 if not provided) describing the number of \code{period.types} to move forward (first) or back (last). For example, to return the last 3 weeks of a time oriented zoo object, one could call \code{last(X,'3 weeks')}. Valid period.types are: secs, seconds, mins, minutes, hours, days, weeks, months, quarters, and years. It is possible to use any frequency specification (secs, mins, days, \ldots) for the period.type portion of the string, even if the original data is in a higher frequency. This makes it possible to return the last \sQuote{2 months} of data from an oject that has a daily periodicity. It should be noted that it is only possible to extract data with methods equal to or less than the frequency of the original data set. Attempting otherwise will result in error. Requesting more data than is in the original data object will produce a warning advising as such, and the object returned will simply be the original data. } \value{ A subset of elements/rows of the original data. } \author{ Jeffrey A. Ryan } \examples{ first(1:100) last(1:100) data(LakeHuron) first(LakeHuron,10) last(LakeHuron) x <- xts(1:100, Sys.Date()+1:100) first(x, 10) first(x, '1 day') first(x, '4 days') first(x, 'month') last(x, '2 months') last(x, '6 weeks') } \keyword{ utilities } xts/man/xts-internals.Rd0000644000176200001440000000516514522244666014767 0ustar liggesusers\name{xtsInternals} \alias{.dimnames.xts} \alias{dimnames.xts<-} \title{ Internal Documentation } \description{ This help file is to help in development of xts, as well as provide some clarity and insight into its purpose and implementation. Last modified: 2008-08-06 by Jeffrey A. Ryan Version: 0.5-0 and above The \pkg{xts} package xts designed as a drop-in replacement for the very popular \pkg{zoo} package. Most all functionality of zoo has been extended or carries into the xts package. Notable changes in direction include the use of time-based indexing, at first explicitely, now implicitely. An \code{xts} object consists of data in the form of a matrix, an index - ordered and increasing, either numeric or integer, and additional attributes for use internally, or for end-user purposes. The current implementation enforces two major rules on the object. One is that the index must be coercible to numeric, by way of \code{as.POSIXct}. There are defined types that meet this criteria. See \code{timeBased} for details. The second requirement is that the object cannot have rownames. The motivation from this comes in part from the work Matthew Doyle has done in his data.table class, in the package of the same name. Rownames in \R must be character vectors, and as such are inefficient in both storage and conversion. By eliminating the rownames, and providing a numeric index of \R internal type \code{REAL} or \code{INTEGER}, it is possible to maintain a connection to standard \R date and time classes via the POSIXct functions, while at at the same time maximizing efficiencies in data handling. User level functions \code{index}, as well as conversion to other classes proceeds as if there were rownames. The code for \code{index} automatically converts time to numeric in both extraction and replacement functionality. This provides a level of abstraction to facilitate internal, and external package use and inter-operability. There is also new work on providing a C-level API to some of the xts functionality to facilitate external package developers to utilize the fast utility routines such as subsetting and merges, without having to call only from \R. Obviously this places far more burden on the developer to not only understand the internal xts implementation, but also to understand all of what is documented for R-internals (and much that isn't). At present the functions and macros available can be found in the \sQuote{xts.h} file in the src directory. There is no current documentation for this API. The adventure starts here. Future documentation is planned, not implemented. } \author{ Jeffrey A. Ryan } \keyword{ utilities } xts/man/timeBased.Rd0000644000176200001440000000106114522244666014040 0ustar liggesusers\name{timeBased} \alias{timeBased} \alias{is.timeBased} \title{ Check if Class is Time-Based } \description{ Used to verify that the object is one of the known time-based classes in R. } \usage{ is.timeBased(x) timeBased(x) } \arguments{ \item{x}{ object to test } } \details{ Current time-based objects supported are \code{Date}, \code{POSIXct}, \code{chron}, \code{yearmon}, \code{yearqtr}, and \code{timeDate}. } \value{ Logical } \author{ Jeffrey A. Ryan } \examples{ timeBased(Sys.time()) timeBased(Sys.Date()) timeBased(200701) } \keyword{ utilities } xts/man/rbind.xts.Rd0000644000176200001440000000377214522244666014071 0ustar liggesusers\name{rbind.xts} \alias{rbind.xts} \alias{c.xts} \title{ Concatenate Two or More xts Objects by Row } \description{ Concatenate or bind by row two or more xts objects along a time-based index. } \usage{ \method{c}{xts}(...) \method{rbind}{xts}(..., deparse.level = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{\dots}{ objects to bind } \item{deparse.level}{ not implemented } } \details{ Implemented in C, these functions bind \code{xts} objects by row, resulting in another \code{xts} object There may be non-unique index values in either the original series, or the resultant series. Identical indexed series are bound in the order or the arguments passed to rbind. See examples. All objects must have the same number of columns, as well as be \code{xts} objects or coercible to such. \code{rbind} and \code{c} are aliases. For traditional merge operations, see \code{merge.xts} and \code{cbind.xts}. } \value{ An \code{xts} object with one row per row for each object concatenated. } \author{ Jeffrey A. Ryan } \note{ This differs from rbind.zoo in that non-unique index values are allowed, in addition to the completely different algorithms used internally. All operations may not behave as expected on objects with non-unique indices. You have been warned. \code{rbind} is a .Primitive function in \R. As such method dispatch occurs at the C-level, and may not be consistent with expectations. See the details section of the base function, and if needed call rbind.xts directly to avoid dispatch ambiguity. } \seealso{ \code{\link{merge.xts}} \code{\link{rbind}} } \examples{ x <- xts(1:10, Sys.Date()+1:10) str(x) merge(x,x) rbind(x,x) rbind(x[1:5],x[6:10]) c(x,x) # this also works on non-unique index values x <- xts(rep(1,5), Sys.Date()+c(1,2,2,2,3)) y <- xts(rep(2,3), Sys.Date()+c(1,2,3)) # overlapping indexes are appended rbind(x,y) rbind(y,x) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ utilities } xts/man/period.sum.Rd0000644000176200001440000000222314522244665014230 0ustar liggesusers\name{period.sum} \alias{period.sum} \title{ Calculate Sum By Period } \description{ Calculate a sum for each period of INDEX. Essentially a rolling application of sum over a series of non-overlapping sections. } \usage{ period.sum(x, INDEX) } \arguments{ \item{x}{ a univariate data object } \item{INDEX}{ a numeric vector of endpoints to calculate sum on } } \details{ Used to calculate a sum per period given an arbitrary index of sections to be calculated over. This is an optimized function for sum. There are additionally optimized versions for min, max, and prod. For xts-coercible objects, an appropriate INDEX can be derived from a call to \code{endpoints}. } \value{ An \code{xts} or \code{zoo} object of sums, indexed by the period endpoints. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}}, \code{\link{period.max}}, \code{\link{period.min}}, \code{\link{period.prod}} } \examples{ period.sum(c(1,1,4,2,2,6,7,8,-1,20),c(0,3,5,8,10)) data(sample_matrix) period.sum(sample_matrix[,1],endpoints(sample_matrix)) period.sum(as.xts(sample_matrix)[,1],endpoints(sample_matrix)) } \keyword{ utilities }% __ONLY ONE__ keyword per line xts/man/addLegend.Rd0000644000176200001440000000211014522244665014005 0ustar liggesusers\name{addLegend} \alias{addLegend} \title{Add Legend} \usage{ addLegend(legend.loc = "topright", legend.names = NULL, col = NULL, ncol = 1, on = 0, ...) } \arguments{ \item{legend.loc}{legend.loc places a legend into one of nine locations on the chart: bottomright, bottom, bottomleft, left, topleft, top, topright, right, or center.} \item{legend.names}{character vector of names for the legend. If \code{NULL}, the column names of the current plot object are used.} \item{col}{fill colors for the legend. If \code{NULL}, the colorset of the current plot object data is used.} \item{ncol}{number of columns for the legend} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}. The default, \code{on=0}, will add to the active panel. The active panel is defined as the panel on which the most recent action was performed. Note that only the first element of \code{on} is checked for the default behavior to add to the last active panel.} \item{\dots}{any other passthrough parameters to \code{\link{legend}}.} } \description{ Add Legend } \author{ Ross Bennett } xts/man/xtsAPI.Rd0000644000176200001440000000267414522244666013326 0ustar liggesusers\name{xtsAPI} \alias{xtsAPI} \title{ xts C API Documentation } \description{ This help file is to help in development of xts, as well as provide some clarity and insight into its purpose and implementation. By Jeffrey A. Ryan, Dirk Eddelbuettel, and Joshua M. Ulrich Last modified: 2018-05-02 Version: 0.10-3 and above At present the \pkg{xts} API has publicly available interfaces to the following functions (as defined in \code{xtsAPI.h}): \preformatted{ Callable from other R packages: SEXP xtsIsOrdered(SEXP x, SEXP increasing, SEXP strictly) SEXP xtsNaCheck(SEXP x, SEXP check) SEXP xtsTry(SEXP x) SEXP xtsRbind(SEXP x, SEXP y, SEXP dup) SEXP xtsCoredata(SEXP x) SEXP xtsLag(SEXP x, SEXP k, SEXP pad) Internal use functions: SEXP isXts(SEXP x) void copy_xtsAttributes(SEXP x, SEXP y) void copy_xtsCoreAttributes(SEXP x, SEXP y) Internal use macros: xts_ATTRIB(x) xts_COREATTRIB(x) GET_xtsIndex(x) SET_xtsIndex(x,value) GET_xtsIndexFormat(x) SET_xtsIndexFormat(x,value) GET_xtsCLASS(x) SET_xtsCLASS(x,value) Internal use SYMBOLS: xts_IndexSymbol xts_ClassSymbol xts_IndexFormatSymbol Callable from R: SEXP mergeXts(SEXP args) SEXP rbindXts(SEXP args) SEXP tryXts(SEXP x) } } \examples{ \dontrun{ # some example code to look at file.show(system.file('api_example/README', package="xts")) file.show(system.file('api_example/src/checkOrder.c', package="xts")) } } \author{ Jeffrey A. Ryan } \keyword{ utilities } xts/man/tzone.Rd0000644000176200001440000000611514522244666013307 0ustar liggesusers\name{tzone} \alias{tzone} \alias{tzone<-} \alias{tzone.xts} \alias{tzone<-.xts} \alias{indexTZ} \alias{indexTZ<-} \alias{TimeZone} \title{ Get or Replace the Timezone of an xts Object's Index } \description{ Generic functions to get or replace the timezone of an xts object's index. } \usage{ tzone(x, \dots) tzone(x) <- value \method{tzone}{xts}(x, \dots) \method{tzone}{xts}(x) <- value ##### The functions below are DEPRECATED ##### indexTZ(x, \dots) indexTZ(x) <- value } \arguments{ \item{x}{ an \code{xts} object } \item{value}{ a valid timezone value (see \code{OlsonNames()}) } \item{\dots}{ arguments passed to other methods } } \details{ Internally, an xts object's index is a \emph{numeric} value corresponding to seconds since the epoch in the UTC timezone. When an xts object is created, all time index values are converted internally to \code{\link{POSIXct}} (which is also in seconds since the UNIX epoch), using the underlying OS conventions and the \env{TZ} environment variable. The \code{xts()} function manages timezone information as transparently as possible. The \code{tzone<-} function \emph{does not} change the internal index values (i.e. the index will remain the same time in the UTC timezone). } \note{ Both \code{indexTZ} and \code{indexTZ<-} are deprecated in favor of \code{tzone} and \code{tzone<-}, respectively. Problems may arise when an object that had been created under one timezone are used in a session using another timezone. This isn't usually a issue, but when it is a warning is given upon printing or subsetting. This warning may be suppressed by setting \code{options(xts_check_TZ = FALSE)}. } \value{ A one element named vector containing the timezone of the object's index. } \note{ Both \code{indexTZ} and \code{indexTZ<-} are deprecated in favor of \code{tzone} and \code{tzone<-}, respectively. Timezones are a difficult issue to manage. It's best to set the system \env{TZ} environment variable to "GMT" or "UTC" (via \code{Sys.setenv(TZ = "UTC")} at the beginning of your scripts if you do not need intra-daily resolution. } \seealso{ \code{\link{POSIXt}} \code{\link{index}} has more information on the xts index, \code{\link{tformat}} describes how the index values are formatted when printed, and \code{\link{tclass}} provides details how \pkg{xts} handles the class of the index. } \author{ Jeffrey A. Ryan } \examples{ # Date indexes always have a "UTC" timezone x <- xts(1, Sys.Date()) tzone(x) str(x) print(x) # The default 'tzone' is blank -- your machine's local timezone, # determined by the 'TZ' environment variable. x <- xts(1, Sys.time()) tzone(x) str(x) # now set 'tzone' to different values tzone(x) <- "UTC" str(x) tzone(x) <- "America/Chicago" str(x) y <- timeBasedSeq('2010-01-01/2010-01-03 12:00/H') y <- xts(seq_along(y), y, tzone = "America/New_York") # Changing the tzone does not change the internal index values, but it # does change how the index is printed! head(y) head(.index(y)) tzone(y) <- "Europe/London" head(y) # the index prints with hours, but head(.index(y)) # the internal index is not changed! } \keyword{ts} \keyword{utilities} xts/man/to.period.Rd0000644000176200001440000001221414522244666014050 0ustar liggesusers\name{to.period} \alias{to.period} \alias{to_period} \alias{to.minutes} \alias{to.minutes3} \alias{to.minutes5} \alias{to.minutes10} \alias{to.minutes15} \alias{to.minutes30} \alias{to.hourly} \alias{to.daily} \alias{to.weekly} \alias{to.monthly} \alias{to.quarterly} \alias{to.yearly} \alias{OHLC} \title{ Convert time series data to an OHLC series } \description{ Convert an OHLC or univariate object to a specified periodicity lower than the given data object. For example, convert a daily series to a monthly series, or a monthly series to a yearly one, or a one minute series to an hourly series. The result will contain the open and close for the given period, as well as the maximum and minimum over the new period, reflected in the new high and low, respectively. If volume for a period was available, the new volume will also be calculated. } \usage{ to.minutes(x,k,name,...) to.minutes3(x,name,...) to.minutes5(x,name,...) to.minutes10(x,name,...) to.minutes15(x,name,...) to.minutes30(x,name,...) to.hourly(x,name,...) to.daily(x,drop.time=TRUE,name,...) to.weekly(x,drop.time=TRUE,name,...) to.monthly(x,indexAt='yearmon',drop.time=TRUE,name,...) to.quarterly(x,indexAt='yearqtr',drop.time=TRUE,name,...) to.yearly(x,drop.time=TRUE,name,...) to.period(x, period = 'months', k = 1, indexAt, name=NULL, OHLC = TRUE, ...) } \arguments{ \item{x}{ a univariate or OHLC type time-series object } \item{period}{ period to convert to. See details. } \item{indexAt}{ convert final index to new class or date. See details } \item{drop.time}{ remove time component of POSIX datestamp (if any) } \item{k}{ number of sub periods to aggregate on (only for minutes and seconds) } \item{name}{ override column names } \item{OHLC}{ should an OHLC object be returned? (only \code{OHLC=TRUE} currently supported) } % \item{addlast}{ passed to \code{endpoints}. See also. } \item{\dots}{ additional arguments } } \details{ Essentially an easy and reliable way to convert one periodicity of data into any new periodicity. It is important to note that all dates will be aligned to the \emph{end} of each period by default - with the exception of \code{to.monthly} and \code{to.quarterly}, which index by \sQuote{yearmon} and \sQuote{yearqtr} from the \pkg{zoo} package, respectively. Valid period character strings include: \code{"seconds"}, \code{"minutes"}, \code{"hours"}, \code{"days"}, \code{"weeks"}, \code{"months"}, \code{"quarters"}, and \code{"years"}. These are calculated internally via \code{endpoints}. See that function's help page for further details. To adjust the final indexing style, it is possible to set \code{indexAt} to one of the following: \sQuote{yearmon}, \sQuote{yearqtr}, \sQuote{firstof}, \sQuote{lastof}, \sQuote{startof}, or \sQuote{endof}. The final index will then be \code{yearmon}, \code{yearqtr}, the first time of the period, the last time of the period, the starting time in the data for that period, or the ending time in the data for that period, respectively. It is also possible to pass a single time series, such as a univariate exchange rate, and return an OHLC object of lower frequency - e.g. the weekly OHLC of the daily series. Setting \code{drop.time} to \code{TRUE} (the default) will convert a series that includes a time component into one with just a date index, as the time index is often of little value in lower frequency series. It is not possible to convert a series from a lower periodicity to a higher periodicity - e.g. weekly to daily or daily to 5 minute bars, as that would require magic. } \value{ An object of the original type, with new periodicity. } \note{ In order for this function to work properly on OHLC data, it is necessary that the Open, High, Low and Close columns be names as such; including the first letter capitalized and the full spelling found. Internally a call is made to reorder the data into the correct column order, and then a verification step to make sure that this ordering and naming has succeeded. All other data formats must be aggregated with functions such as \code{aggregate} and \code{period.apply}. This method should work on almost all time-series-like objects. Including \sQuote{timeSeries}, \sQuote{zoo}, \sQuote{ts}, and \sQuote{irts}. It is even likely to work well for other data structures - including \sQuote{data.frames} and \sQuote{matrix} objects. Internally a call to \code{as.xts} converts the original \code{x} into the universal \code{xts} format, and then re-converts back to the original type. A special note with respect to \sQuote{ts} objects. As these are strictly regular they may include \code{NA} values. These are stripped for aggregation purposes, though replaced before returning. This inevitably leads to many, many additional \sQuote{NA} values in the data. It is more beneficial to consider using an \sQuote{xts} object originally, or converting to one in the function call by means of \code{as.xts}. } \examples{ data(sample_matrix) samplexts <- as.xts(sample_matrix) to.monthly(samplexts) to.monthly(sample_matrix) str(to.monthly(samplexts)) str(to.monthly(sample_matrix)) } \author{ Jeffrey A. Ryan } \keyword{ utilities } xts/man/endpoints.Rd0000644000176200001440000000350014522244665014145 0ustar liggesusers\name{endpoints} \alias{endpoints} \title{ Locate Endpoints by Time } \description{ Extract index locations for an \code{xts} object that correspond to the \emph{last} observation in each period specified by \code{on}. } \usage{ endpoints(x, on="months", k=1) } \arguments{ \item{x}{ an xts object } \item{on}{ the periods endpoints to find as a character string } \item{k}{ along every k-th element - see notes } } \details{ \code{endpoints} returns a numeric vector corresponding to the \emph{last} observation in each period. The vector always begins with zero and ends with the last observation in \code{x}. Periods are always based on the distance from the UNIX epoch (midnight 1970-01-01 UTC), \emph{not the first observation in \code{x}}. The examples illustrate this behavior. Valid values for the argument \code{on} include: \dQuote{us} (microseconds), \dQuote{microseconds}, \dQuote{ms} (milliseconds), \dQuote{milliseconds}, \dQuote{secs} (seconds), \dQuote{seconds}, \dQuote{mins} (minutes), \dQuote{minutes}, \dQuote{hours}, \dQuote{days}, \dQuote{weeks}, \dQuote{months}, \dQuote{quarters}, and \dQuote{years}. } \value{ A numeric vector of beginning with 0 and ending with the value equal to the number of observations in the \code{x} argument. } \author{ Jeffrey A. Ryan } \examples{ data(sample_matrix) endpoints(sample_matrix) endpoints(sample_matrix, "weeks") ### example of how periods are based on the UNIX epoch, ### *not* the first observation of the data series x <- xts(1:38, yearmon(seq(2018 - 1/12, 2021, 1/12))) # endpoints for the end of every other year ep <- endpoints(x, "years", k = 2) # Dec-2017 is the end of the *first* year in the data. But when you start from # Jan-1970 and use every second year end as your endpoints, the endpoints are # always December of every odd year. x[ep, ] } \keyword{ utilities } xts/man/period.min.Rd0000644000176200001440000000223214522244665014207 0ustar liggesusers\name{period.min} \alias{period.min} \title{ Calculate Min By Period } \description{ Calculate a minimum for each period of INDEX. Essentially a rolling application of minimum over a series of non-overlapping sections. } \usage{ period.min(x, INDEX) } \arguments{ \item{x}{ a univariate data object } \item{INDEX}{ a numeric vector of endpoints to calculate maximum on } } \details{ Used to calculate a minimum per period given an arbitrary index of sections to be calculated over. This is an optimized function for minimum. There are additional optimized versions for max, sum, and prod. For xts-coercible objects, an appropriate INDEX can be derived from a call to \code{endpoints}. } \value{ An xts or zoo object of minimums, indexed by the period endpoints. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}}, \code{\link{period.sum}}, \code{\link{period.max}}, \code{\link{period.prod}} } \examples{ period.min(c(1,1,4,2,2,6,7,8,-1,20),c(0,3,5,8,10)) data(sample_matrix) period.min(sample_matrix[,1],endpoints(sample_matrix)) period.min(as.xts(sample_matrix)[,1],endpoints(sample_matrix)) } \keyword{ utilities }% __ONLY ONE__ keyword per line xts/man/xts.Rd0000644000176200001440000001446614525744667013007 0ustar liggesusers\name{xts} \alias{xts} \alias{.xts} \alias{is.xts} \title{ Create Or Test For An xts Time-Series Object } \description{ Constructor function for creating an extensible time-series object. \code{xts} is used to create an \code{xts} object from raw data inputs. } \usage{ xts(x = NULL, order.by = index(x), frequency = NULL, unique = TRUE, tzone = Sys.getenv("TZ"), ...) .xts(x = NULL, index, tclass = c("POSIXct", "POSIXt"), tzone = Sys.getenv("TZ"), check = TRUE, unique = FALSE, ...) is.xts(x) } \arguments{ \item{x}{ an object containing the time series data } \item{order.by}{ a corresponding vector of dates/times of a known time-based class. See Details. } \item{index}{ a corresponding \emph{numeric} vector specified as seconds since the UNIX epoch (1970-01-01 00:00:00.000) } \item{frequency}{ numeric indicating frequency of \code{order.by}. See Details. } \item{unique}{ check the index for unique timestamps? } \item{check}{ check that the index is ordered? } \item{tclass}{ time class to use for the index. See \code{\link{tclass}}. } \item{tzone}{ time zone of the index (ignored indices without a time component, e.g. Date, yearmon, yearqtr). See \code{\link{tzone}}. } \item{\dots}{ additional attributes to be added. See Details. } } \details{ An \code{xts} object extends the S3 class \code{zoo} from the package of the same name. The \code{xts()} constructor is the preferred way to create xts objects. It performs several checks to ensure it returns a well-formed xts object. The \code{.xts()} constructor is mainly for internal use. It is more efficient than the regular \code{xts()} constructor because it doesn't perform as many validity checks. Use it with caution. % TODO: add notes here about the differences between 'empty', 'zero-width', and % 'zero-length' xts objects. Similar to zoo objects, xts objects must have an ordered index. While zoo indexes cannot contain duplicate values, xts objects have optionally supported duplicate index elements since version 0.5-0. The \code{xts} class has one additional requirement, the index must be a time-based class. Currently supported classes include: \sQuote{Date}, \sQuote{POSIXct}, \sQuote{timeDate}, as well as \sQuote{yearmon} and \sQuote{yearqtr} where the index values remain unique. The uniqueness requirement was relaxed in version 0.5-0, but is still enforced by default. Setting \code{unique = FALSE} skips the uniqueness check and only ensures that the index is ordered via the \code{isOrdered} function. As of version 0.10-0, xts no longer allows missing values in the index. This is because many xts functions expect all index values to be finite. The most important of these is \code{merge.xts}, which is used ubiquitously. Missing values in the index are usually the result of a date-time conversion error (e.g. incorrect format, non-existent time due to daylight saving time, etc). Because of how non-finite numbers are represented, a missing timestamp will always be at the end of the index (except if it is \code{-Inf}, which will be first). Another difference from \pkg{zoo} is that xts object may carry additional attributes that may be desired in individual time-series handling. This includes the ability to augment the objects data with meta-data otherwise not cleanly attachable to a standard zoo object. Examples of usage from finance may include the addition of data for keeping track of sources, last-update times, financial instrument descriptions or details, etc. The idea behind \code{xts} is to offer the user the ability to utilize a standard zoo object, while providing an mechanism to customize the object's meta-data, as well as create custom methods to handle the object in a manner required by the user. Many xts-specific methods have been written to better handle the unique aspects of xts. These include, \sQuote{"["}, merge, cbind, rbind, c, Ops, lag, diff, coredata, head and tail. Additionally there are xts specific methods for converting to/from R's different time-series classes. Subsetting via "[" methods offers the ability to specify dates by range, if they are enclosed in quotes. The style borrows from python by creating ranges with a double colon \dQuote{"::"} or \dQuote{"/"} operator. Each side of the operator may be left blank, which would then default to the beginning and end of the data, respectively. To specify a subset of times, it is only required that the time specified be in standard ISO format, with some form of separation between the elements. The time must be \sQuote{left-filled}, that is to specify a full year one needs only to provide the year, a month would require the full year and the integer of the month requested - e.g. '1999-01'. This format would extend all the way down to seconds - e.g. '1999-01-01 08:35:23'. Leading zeros are not necessary. See the examples for more detail. Users may also extend the \code{xts} class to new classes to allow for method overloading. Additional benefits derive from the use of \code{\link{as.xts}} and \code{\link{reclass}}, which allow for lossless two-way conversion between common R time-series classes and the \code{xts} object structure. See those functions for more detail. } \value{ An S3 object of class \code{xts}. As it inherits and extends the zoo class, all zoo methods remain valid. Additional attributes may be assigned and extracted via \code{xtsAttributes}. } \references{ \pkg{zoo}: } \author{ Jeffrey A. Ryan and Joshua M. Ulrich } \note{ Most users will benefit the most by using the \code{as.xts} and \code{reclass} functions to automagically handle \emph{all} data objects as one would handle a \code{zoo} object. } \seealso{ \code{\link{as.xts}}, \code{\link{index}}, \code{\link{tclass}}, \code{\link{tformat}}, \code{\link{tzone}}, \code{\link{xtsAttributes}} } \examples{ data(sample_matrix) sample.xts <- as.xts(sample_matrix, descr='my new xts object') class(sample.xts) str(sample.xts) head(sample.xts) # attribute 'descr' hidden from view attr(sample.xts,'descr') sample.xts['2007'] # all of 2007 sample.xts['2007-03/'] # March 2007 to the end of the data set sample.xts['2007-03/2007'] # March 2007 to the end of 2007 sample.xts['/'] # the whole data set sample.xts['/2007'] # the beginning of the data through 2007 sample.xts['2007-01-03'] # just the 3rd of January 2007 } \keyword{ utilities } xts/man/periodicity.Rd0000644000176200001440000000320014522244665014463 0ustar liggesusers\name{periodicity} \alias{periodicity} \title{ Approximate Series Periodicity } \description{ Estimate the periodicity of a time-series-like object by calculating the median time between observations in days. } \usage{ periodicity(x, ...) } \arguments{ \item{x}{ time-series-like object } \item{\dots}{ unused } } \details{ A simple wrapper to quickly estimate the periodicity of a given data. Returning an object of type \code{periodicity}. This calculates the median number of days between observations as a difftime object, the numerical difference, the units of measurement, and the derived scale of the data as a string. The time index currently must be of either \code{Date} or \code{POSIX} class, or coercible to such. The only list item of note is the \code{scale}. This is an estimate of the periodicity of the data in common terms - e.g. 7 day daily data is best described as \sQuote{weekly}, and would be returned as such. Possible \code{scale} values are: \sQuote{minute},\sQuote{hourly}, \sQuote{daily},\sQuote{weekly}, \sQuote{monthly},\sQuote{quarterly}, and \sQuote{yearly}. } \value{ An object containing a list containing the \code{difftime} object, frequency, units, and suitable scale. } \note{ This function is only a \emph{good estimate} for the underlying periodicity. If the series is too short, or has \emph{no} real periodicity, the return values will obviously be wrong. That said, it is quite robust and used internally within \pkg{xts}. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{difftime}} } \examples{ zoo.ts <- zoo(rnorm(231),as.Date(13514:13744,origin="1970-01-01")) periodicity(zoo.ts) } \keyword{ utilities } xts/man/period.prod.Rd0000644000176200001440000000225314522244665014373 0ustar liggesusers\name{period.prod} \alias{period.prod} \title{ Calculate Product By Period } \description{ Calculate a product for each period of INDEX. Essentially a rolling application of prod over a series of non-overlapping sections. } \usage{ period.prod(x, INDEX) } \arguments{ \item{x}{ a univariate data object } \item{INDEX}{ a vector of breakpoints to calculate product on } } \details{ Used to calculate a product per period given an arbitrary index of sections to be calculated over. This is an optimized function for product. There are additionally optimized versions for min, max, and sum. For xts-coercible objects, an appropriate INDEX can be derived from a call to \code{endpoints}. } \value{ An \code{xts} or \code{zoo} object of products, indexed by the period endpoints. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}}, \code{\link{period.sum}}, \code{\link{period.min}}, \code{\link{period.max}} } \examples{ period.prod(c(1,1,4,2,2,6,7,8,-1,20),c(0,3,5,8,10)) data(sample_matrix) period.prod(sample_matrix[,1],endpoints(sample_matrix)) period.prod(as.xts(sample_matrix)[,1],endpoints(sample_matrix)) } \keyword{ utilities }% __ONLY ONE__ keyword per line xts/man/apply.monthly.Rd0000644000176200001440000000463614525744640014774 0ustar liggesusers\name{apply.monthly} \alias{apply.daily} \alias{apply.weekly} \alias{apply.monthly} \alias{apply.quarterly} \alias{apply.yearly} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Apply Function over Calendar Periods } \description{ Apply a specified function to each distinct period in a given time series object. } \usage{ apply.daily(x, FUN, ...) apply.weekly(x, FUN, ...) apply.monthly(x, FUN, ...) apply.quarterly(x, FUN, ...) apply.yearly(x, FUN, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an time-series object coercible to xts } \item{FUN}{ an \R function } \item{\dots}{ additional arguments to FUN } } \details{ Simple mechanism to apply a function to non-overlapping time periods, e.g. weekly, monthly, etc. Different from rolling functions in that this will subset the data based on the specified time period (implicit in the call), and return a vector of values for each period in the original data. Essentially a wrapper to the \pkg{xts} functions \code{endpoints} and \code{period.apply}, mainly as a convenience. } \note{ When \code{FUN = mean} the results will contain one column for every column in the input, which is different from other math functions (e.g. \code{median}, \code{sum}, \code{prod}, \code{sd}, etc.). \code{FUN = mean} works by column because the default method \code{stats::mean} used to work by column for matrices and data.frames. R Core changed the behavior of \code{mean} to always return one column in order to be consistent with the other math functions. This broke some \pkg{xts} dependencies and \code{mean.xts} was created to maintain the original behavior. Using \code{FUN = mean} will print a message that describes this inconsistency. To avoid the message and confusion, use \code{FUN = colMeans} to calculate means by column and use \code{FUN = function(x) mean} to calculate one mean for all the data. Set \code{options(xts.message.period.apply.mean = FALSE)} to suppress this message. } \value{ A vector of results produced by \code{FUN}, corresponding to the appropriate periods. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}}, \code{\link{period.apply}}, \code{\link{to.monthly}} } \examples{ xts.ts <- xts(rnorm(231),as.Date(13514:13744,origin="1970-01-01")) start(xts.ts) end(xts.ts) apply.monthly(xts.ts,colMeans) apply.monthly(xts.ts,function(x) var(x)) } \keyword{ utilities } xts/man/addPanel.Rd0000644000176200001440000000325614522244665013662 0ustar liggesusers\name{addPanel} \alias{addPanel} \title{Add a panel to an existing xts plot} \usage{ addPanel(FUN, main = "", on = NA, type = "l", col = NULL, lty = 1, lwd = 1, pch = 1, ...) } \arguments{ \item{FUN}{an xts object to plot.} \item{main}{main title for a new panel if drawn.} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}.} \item{type}{the type of plot to be drawn, same as in \code{\link{plot}}.} \item{col}{color palette to use, set by default to rational choices.} \item{lty}{set the line type, same as in \code{\link{par}}.} \item{lwd}{set the line width, same as in \code{\link{par}}.} \item{pch}{the type of plot to be drawn, same as in \code{\link{par}}.} \item{\dots}{additional named arguments passed through to \code{FUN} and any other graphical passthrough parameters.} } \description{ Apply a function to the data of an existing xts plot object and plot the result. \code{FUN} should have arguments \code{x} or \code{R} for the data of the existing xts plot object to be passed to. All other additional arguments for \code{FUN} are passed through \dots. } \author{ Ross Bennett } \examples{ library(xts) data(sample_matrix) sample.xts <- as.xts(sample_matrix) calcReturns <- function(price, method = c("discrete", "log")){ px <- try.xts(price) method <- match.arg(method)[1L] returns <- switch(method, simple = , discrete = px / lag(px) - 1, compound = , log = diff(log(px))) reclass(returns, px) } # plot the Close plot(sample.xts[,"Close"]) # calculate returns addPanel(calcReturns, method="discrete", type="h") # Add simple moving average to panel 1 addPanel(rollmean, k=20, on=1) addPanel(rollmean, k=40, col="blue", on=1) } xts/man/axTicksByTime.Rd0000644000176200001440000000357414522244665014675 0ustar liggesusers\name{axTicksByTime} \alias{axTicksByTime} \title{ Compute x-Axis Tickmark Locations by Time } \description{ Compute x-axis tickmarks like \code{axTicks} in base but with respect to time. Additionally the first argument is the object indexed by time which you are looking to derive tickmark locations for. It is possible to specify the detail you are seeking, or by passing 'auto' to the \code{ticks.on} argument, to get a best heuristic fit. } \usage{ axTicksByTime(x, ticks.on='auto', k = 1, labels=TRUE, format.labels=TRUE, ends=TRUE, gt = 2, lt = 30) } \arguments{ \item{x}{ the object indexed by time, or a vector of times/dates } \item{ticks.on}{ what to break on } \item{k}{ frequency of breaks } \item{labels}{ should a labeled vector be returned } \item{format.labels}{ format labels - may be format to use } \item{ends}{ should the ends be adjusted } \item{gt}{ lower bound on number of breaks } \item{lt}{ upper bound on number of breaks } } \details{ This function is written for internal use, and documented for those wishing to use outside of the internal function uses. In general it is most unlikely that the end user will call this function directly. The \code{format.labels} argument allows for standard formatting like that used in \code{format}, \code{strptime}, and \code{strftime}. } \value{ A numeric vector of index element locations where tick marks should be drawn. These are \emph{locations} (e.g. 1, 2, 3, ...), \emph{not} the index timestamps. If possible, the result will be named using formatted values from the index timestamps. The names will be used for the tick mark labels. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{endpoints}} } \examples{ data(sample_matrix) axTicksByTime(as.xts(sample_matrix),'auto') axTicksByTime(as.xts(sample_matrix),'weeks') axTicksByTime(as.xts(sample_matrix),'months',7) } \keyword{ utilities } xts/man/tclass.Rd0000644000176200001440000000501014522244666013432 0ustar liggesusers\name{tclass} \alias{tclass} \alias{tclass<-} \alias{tclass.xts} \alias{tclass<-.xts} \alias{indexClass} \alias{indexClass<-} \title{ Get or Replace the Class of an xts Object's Index } \description{ Generic functions to get or replace the class of an xts object's index. } \usage{ tclass(x, \dots) tclass(x) <- value \method{tclass}{xts}(x, \dots) \method{tclass}{xts}(x) <- value ##### The functions below are DEPRECATED ##### indexClass(x) indexClass(x) <- value } \arguments{ \item{x}{ an \code{xts} object } \item{value}{ new index class (see Details for valid values) } \item{\dots}{ arguments passed to other methods } } \details{ Internally, an xts object's index is a \emph{numeric} value corresponding to seconds since the epoch in the UTC timezone. The index class is stored as the \code{tclass} attribute on the internal index. This is used to convert the internal index values to the desired class when the \code{index} function is called. The \code{tclass} function retrieves the class of the internal index, and the \code{tclass<-} function sets it. The specified value for \code{tclass<-} must be one of the following character strings: \code{"Date"}, \code{"POSIXct"}, \code{"chron"}, \code{"yearmon"}, \code{"yearqtr"}, or \code{"timeDate"}. } \value{ A vector containing the class of the object's index. } \note{ Both \code{indexClass} and \code{indexClass<-} are deprecated in favor of \code{tclass} and \code{tclass<-}, respectively. Replacing the \code{tclass} \emph{does not} change the values of the internal index. See the examples. } \seealso{ \code{\link{index}} has more information on the xts index, \code{\link{tformat}} details how the index values are formatted when printed, \code{\link{tzone}} has more information about the index timezone settings. The following help pages describe the characteristics of the valid index classes: \code{\link{POSIXct}}, \code{\link{Date}}, \code{\link[chron]{chron}}, \code{\link[zoo]{yearmon}}, \code{\link[zoo]{yearqtr}}, \code{\link[timeDate]{timeDate}}. } \author{ Jeffrey A. Ryan } \examples{ x <- timeBasedSeq('2010-01-01/2010-01-02 12:00') x <- xts(seq_along(x), x) y <- timeBasedSeq('2010-01-01/2010-01-03 12:00/H') y <- xts(seq_along(y), y, tzone = "America/New_York") # Changing the tclass does not change the internal index values, but it # does change how the index is printed! head(y) # the index has times .index(y) tclass(y) <- "Date" head(y) # the index prints without times, but .index(y) # the internal index is not changed! } \keyword{ts} \keyword{utilities} xts/man/as.xts.methods.Rd0000644000176200001440000000560514522244665015034 0ustar liggesusers\name{as.xts.methods} \alias{as.xts.methods} \alias{as.xts.timeSeries} \alias{as.timeSeries.xts} \alias{as.xts.xts} \alias{as.xts.zoo} \alias{as.xts.ts} \alias{as.xts.data.frame} \alias{as.xts.matrix} \title{ Convert Object To And From Class xts } \description{ Conversion S3 methods to coerce data objects of arbitrary classes to class \code{xts} and back, without losing any attributes of the original format. } \usage{ \method{as.xts}{xts}(x,...,.RECLASS=FALSE) \method{as.xts}{timeSeries}(x, dateFormat="POSIXct", FinCenter, recordIDs, title, documentation, ..., .RECLASS=FALSE) \method{as.xts}{zoo}(x, order.by=index(x), frequency=NULL, ..., .RECLASS=FALSE) \method{as.xts}{ts}(x, dateFormat,...,.RECLASS=FALSE) \method{as.xts}{data.frame}(x, order.by, dateFormat="POSIXct", frequency=NULL, ...,.RECLASS=FALSE) \method{as.xts}{matrix}(x, order.by, dateFormat="POSIXct", frequency=NULL, ..., .RECLASS=FALSE) } \arguments{ \item{x}{ data object to convert. See details for supported types } \item{dateFormat}{what format should the dates be converted to} \item{FinCenter}{see timeSeries help} \item{recordIDs}{see timeSeries help} \item{title}{see timeSeries help} \item{documentation}{see timeSeries help} \item{order.by}{see \link[zoo]{zoo} help } \item{frequency}{see \link[zoo]{zoo} help } \item{\dots}{ additional parameters or attributes } \item{.RECLASS}{ should conversion be reversible? } } \details{ A simple and reliable way to convert many different objects into a uniform format for use within \R. It is possible with a call to \code{as.xts} to convert objects of class \code{timeSeries}, \code{ts}, \code{matrix}, \code{data.frame}, and \code{zoo}. Additional name=value pairs may be passed to the function to be added to the new object. A special print.xts method will assure that the attributes are hidden from view, but will be available via \R's standard \code{attr} function. If \code{.RECLASS=TRUE}, the returned object will preserve all relevant attribute/slot data within itself, allowing for temporary conversion to use zoo and xts compatible methods. A call to \code{reclass} returns the object to its original class, with all original attributes intact - unless otherwise changed. This is the default behavior when \code{try.xts} is used for conversion, and should not be altered by the user; i.e. don't touch it unless you are aware of the consequences. It should be obvious, but any attributes added via the \dots argument will not be carried back to the original data object, as there would be no available storage slot/attribute. } \value{ An S3 object of class \code{xts}. } \author{ Jeffrey A. Ryan } \seealso{ \code{\link{xts}}, \code{\link[zoo]{zoo}} } \examples{ \dontrun{ # timeSeries library(timeSeries) x <- timeSeries(1:10, 1:10) str( as.xts(x) ) str( reclass(as.xts(x)) ) str( try.xts(x) ) str( reclass(try.xts(x)) ) } } \keyword{ utilities } xts/man/dimnames.xts.Rd0000644000176200001440000000421414522244665014557 0ustar liggesusers\name{dimnames.xts} \alias{dimnames.xts} \alias{dimnames<-.xts} \title{ Dimnames of an xts Object } \description{ Get or set dimnames of an xts object. } \usage{ \method{dimnames}{xts}(x) \method{dimnames}{xts}(x) <- value } \arguments{ \item{x}{ an xts object } \item{value}{ a list object of length two. See Details. } } \details{ The functions \code{dimnames.xts} and \code{dimnames<-.xts} are methods for the base functions \code{dimnames} and \code{dimnames<-}. \code{xts} objects by design are intended for lightweight management of time-indexed data. Rownames are redundant in this design, as well as quite burdensome with respect to memory consumption and internal copying costs. \code{rownames} and \code{colnames} in \R make use of \code{dimnames} method dispatch internally, and thus require only modifications to dimnames to enforce the \code{xts} no rownames requirement. To prevent accidental setting of rownames, \code{dimnames<-} for \code{xts} will simply set the rownames to \code{NULL} when invoked, regardless of attempts to set otherwise. This is done for internal compatibility reasons, as well as to provide consistency in performance regardless of object use. User level interaction with either dimnames or rownames will produce a character vector of the index, formatted based on the current specification of \code{indexFormat}. This occurs within the call by converting the results of calling \code{index(x)} to a character string, which itself first creates the object type specified internally from the underlying numeric time representation. } \value{ A list or character string containing coerced row names and/or actual column names. Attempts to set rownames on xts objects via rownames or dimnames will silently fail. This is your warning. } \author{ Jeffrey A. Ryan } \note{ All \code{xts} objects have dimension. There are no \code{xts} objects representable as named or unnamed vectors. } \seealso{ \code{\link{xts}} } \examples{ x <- xts(1:10, Sys.Date()+1:10) dimnames(x) rownames(x) rownames(x) <- 1:10 rownames(x) str(x) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ misc } xts/man/sample.data.Rd0000644000176200001440000000077314522244666014345 0ustar liggesusers\name{sample_matrix} \alias{sample_matrix} \docType{data} \title{ Sample Data Matrix For xts Example and Unit Testing } \description{ Simulated 180 observations on 4 variables. } \usage{data(sample_matrix)} \format{ \preformatted{ The format is: num [1:180, 1:4] 50.0 50.2 50.4 50.4 50.2 ... - attr(*, "dimnames")=List of 2 ..$ : chr [1:180] "2007-01-02" "2007-01-03" "2007-01-04" "2007-01-05" ... ..$ : chr [1:4] "Open" "High" "Low" "Close" } } \examples{ data(.sample.matrix) } \keyword{datasets} xts/man/addPolygon.Rd0000644000176200001440000000250314525744640014245 0ustar liggesusers\name{addPolygon} \alias{addPolygon} \title{Add a polygon to an existing xts plot} \description{ Draw a polygon on an existing xts plot by specifying a time series of y coordinates. The xts index is used for the x coordinates and the first two columns are the upper and lower y coordinates, respectively. } \usage{ addPolygon(x, y = NULL, main = "", on = NA, col = NULL, ...) } \arguments{ \item{x}{ an xts object to plot. Must contain 2 columns for the upper and lower y coordinates for the polygon. The first column is interpreted as the upper y coordinates and the second column as the lower y coordinates. } \item{y}{NULL, not used} \item{main}{main title for a new panel if drawn.} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}.} \item{col}{color palette to use, set by default to rational choices.} \item{\dots}{passthru parameters to \code{\link{par}}} } \examples{ \dontrun{ library(xts) data(sample_matrix) x <- as.xts(sample_matrix)[,1] ix <- index(x["2007-02"]) shade <- xts(matrix(rep(range(x), each = length(ix)), ncol = 2), ix) plot(x) # set on = -1 to draw the shaded region *behind* the main series addPolygon(shade, on = -1, col = "lightgrey") } } \references{ Based on code by Dirk Eddelbuettel from \url{http://dirk.eddelbuettel.com/blog/2011/01/16/} } \author{Ross Bennett} xts/man/na.locf.xts.Rd0000644000176200001440000000276214522244665014310 0ustar liggesusers\name{na.locf.xts} \alias{na.locf.xts} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Last Observation Carried Forward } \description{ \pkg{xts} method replace \sQuote{NA} with most recent non-\sQuote{NA} } \usage{ \method{na.locf}{xts}(object, na.rm = FALSE, fromLast = FALSE, maxgap=Inf, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ an xts object } \item{na.rm}{ logical. Should leading/trailing \sQuote{NA}'s be removed? The default for xts \code{FALSE} is different than the default S3 method in the \pkg{zoo} package. } \item{fromLast}{ logical. Cause observations to be carried backward rather than forward. Default is \code{FALSE}. } \item{maxgap}{ runs of more than \sQuote{maxgap} will retain \sQuote{NA}s after the maximum gap specified. See \code{na.locf} in the zoo package. } \item{\dots}{ unused } } \details{ This is the \pkg{xts} method for the S3 generic \code{na.locf}. The primary difference to note is that after the \sQuote{NA} fill action is carried out, the default it to leave trailing or leading \sQuote{NA}'s in place. This is different than \pkg{zoo} behavior. } \value{ See the documentation in zoo. } \references{ \sQuote{zoo} } \author{ Jeffrey A. Ryan } \examples{ x <- xts(1:10, Sys.Date()+1:10) x[c(1,2,5,9,10)] <- NA x na.locf(x) na.locf(x, fromLast=TRUE) na.locf(x, na.rm=TRUE, fromLast=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ misc } xts/man/print.Rd0000644000176200001440000000215314522244666013302 0ustar liggesusers\name{print.xts} \alias{print.xts} \title{ Print An xts Time-Series Object } \description{ Method for printing an extensible time-series object. } \usage{ \method{print}{xts}(x, fmt, ..., show.rows = 10, max.rows = 100) } \arguments{ \item{x}{ An xts object } \item{fmt}{ Passed to \code{\link{coredata}} to format the time index } \item{\dots}{ Arguments passed to other methods } \item{show.rows}{ The number of first and last rows to print if the number of rows is truncated (default 10, or \code{getOption("xts.print.show.rows")}) } \item{max.rows}{ The output will contain at most \code{max.rows} rows before being truncated (default 100, or \code{getOption("xts.print.max.rows")}) } } %\details{ % Add notes about truncated rows, columns, any addition descriptive information we add % %} \value{ Returns \code{x} invisibly. } \author{ Joshua M. Ulrich } \examples{ data(sample_matrix) sample.xts <- as.xts(sample_matrix) # output is truncated and shows first and last 10 observations print(sample.xts) # show the first and last 5 observations print(sample.xts, show.rows = 5) } \keyword{ print } xts/man/addSeries.Rd0000644000176200001440000000152214522244665014047 0ustar liggesusers\name{addSeries} \alias{addSeries} \title{Add a time series to an existing xts plot} \usage{ addSeries(x, main = "", on = NA, type = "l", col = NULL, lty = 1, lwd = 1, pch = 1, ...) } \arguments{ \item{x}{an xts object to plot.} \item{main}{main title for a new panel if drawn.} \item{on}{panel number to draw on. A new panel will be drawn if \code{on=NA}.} \item{type}{the type of plot to be drawn, same as in \code{\link{plot}}.} \item{col}{color palette to use, set by default to rational choices.} \item{lty}{set the line type, same as in \code{\link{par}}.} \item{lwd}{set the line width, same as in \code{\link{par}}.} \item{pch}{the type of plot to be drawn, same as in \code{\link{par}}.} \item{\dots}{any other passthrough graphical parameters.} } \description{ Add a time series to an existing xts plot } \author{ Ross Bennett } xts/man/as.environment.Rd0000644000176200001440000000210714522244665015112 0ustar liggesusers\name{as.environment.xts} \alias{as.environment.xts} \title{ Coerce an \sQuote{xts} Object to an Environment by Column } \description{ Method to automatically convert an \sQuote{xts} object to an environment containing vectors representing each column of the original xts object. Each objects will be named according to the column name it is exracted by. } \usage{ \method{as.environment}{xts}(x) } \arguments{ \item{x}{ an \code{xts} object } } \details{ An experimental tool to convert \code{xts} objects into environments for simplifying use withing the standard R formula/data paradigm. } \value{ An \code{environment} containing \code{ncol(x)} vectors extracted by column from \code{x}. Note that environments do not preserve (or have knowledge) of column position, a.k.a order. } \author{ Jeffrey A. Ryan } \examples{ x <- xts(1:10, Sys.Date()+1:10) colnames(x) <- "X" y <- xts(1:10, Sys.Date()+1:10) colnames(x) <- "Y" xy <- cbind(x,y) colnames(xy) e <- as.environment(xy) # currently using xts-style positive k ls(xy) ls.str(xy) } \keyword{ manip }% __ONLY ONE__ keyword per line xts/man/period.apply.Rd0000644000176200001440000000540514525744640014557 0ustar liggesusers\name{period.apply} \alias{period.apply} \title{ Apply Function Over Specified Interval } \description{ Apply a specified function to data over intervals specified by \code{INDEX}. The intervals are defined as the observations from \code{INDEX[k]+1} to \code{INDEX[k+1]}, for \code{k = 1:(length(INDEX)-1)}. } \usage{ period.apply(x, INDEX, FUN, ...) } \arguments{ \item{x}{ The data that FUN will be applied to. } \item{INDEX}{ A numeric vector of index breakpoint locations. The vector should begin with 0 and end with \code{NROW(x)}. } \item{FUN}{ A \code{function} to apply to each interval in \code{x}. } \item{\dots}{ Additional arguments for \code{FUN}. } } \details{ Similar to the rest of the apply family, \code{period.apply()} calculates the specified function's value over a subset of data. The primary difference is that \code{period.apply()} applies the function to non-overlapping intervals of a vector or matrix. Useful for applying functions over an entire data object by any non-overlapping intervals. For example, when \code{INDEX} is the result of a call to \code{endpoints()}. \code{period.apply()} checks that \code{INDEX} is sorted, unique, starts with 0, and ends with \code{NROW(x)}. All those conditions are true of vectors returned by \code{endpoints()}. } \note{ When \code{FUN = mean} the results will contain one column for every column in the input, which is different from other math functions (e.g. \code{median}, \code{sum}, \code{prod}, \code{sd}, etc.). \code{FUN = mean} works by column because the default method \code{stats::mean} used to work by column for matrices and data.frames. R Core changed the behavior of \code{mean} to always return one column in order to be consistent with the other math functions. This broke some \pkg{xts} dependencies and \code{mean.xts} was created to maintain the original behavior. Using \code{FUN = mean} will print a message that describes this inconsistency. To avoid the message and confusion, use \code{FUN = colMeans} to calculate means by column and use \code{FUN = function(x) mean} to calculate one mean for all the data. Set \code{options(xts.message.period.apply.mean = FALSE)} to suppress this message. } \value{ An object with \code{length(INDEX) - 1} observations (assuming \code{INDEX} starts with 0 and ends with \code{NROW(x)}). } \author{ Jeffrey A. Ryan, Joshua M. Ulrich } \seealso{ \code{\link{endpoints}} \code{\link{apply.monthly}}} \examples{ zoo.data <- zoo(rnorm(31)+10,as.Date(13514:13744,origin="1970-01-01")) ep <- endpoints(zoo.data,'weeks') period.apply(zoo.data, INDEX=ep, FUN=function(x) colMeans(x)) period.apply(zoo.data, INDEX=ep, FUN=colMeans) #same period.apply(letters,c(0,5,7,26), paste0) } \keyword{ utilities }% __ONLY ONE__ keyword per line xts/man/index.Rd0000644000176200001440000002063214522244665013256 0ustar liggesusers\name{index.xts} \alias{index.xts} \alias{index<-.xts} \alias{.index} \alias{.index<-} \alias{.indexhour} \alias{.indexsec} \alias{.indexmin} \alias{.indexyear} \alias{.indexymon} \alias{.indexyday} \alias{.indexday} \alias{.indexDate} \alias{.indexmday} \alias{.indexwday} \alias{.indexweek} \alias{.indexmon} \alias{.indexisdst} \alias{convertIndex} \title{ Get and Replace the Class of an xts Index } \description{ Functions to get and replace an xts object's index values and it's components. } \usage{ \method{index}{xts}(x, ...) \method{index}{xts}(x) <- value .index(x, ...) .index(x) <- value convertIndex(x, value) # date/time component extraction .indexsec(x) .indexmin(x) .indexhour(x) .indexDate(x) .indexday(x) .indexwday(x) .indexmday(x) .indexweek(x) .indexmon(x) .indexyear(x) .indexyday(x) .indexisdst(x) } \arguments{ \item{x}{ an \code{xts} object } \item{value}{ new index value } \item{\dots}{ arguments passed to other methods } } \details{ Internally, an xts object's index is a \emph{numeric} value corresponding to seconds since the epoch in the UTC timezone. The \code{.index} and \code{.index<-} functions get and replace the internal \emph{numeric} value of the index, respectively. These functions are primarily for internal use, but are exported because they may be useful for users. The \code{index} and \code{index<-} methods get and replace the xts object's index, respectively. The replacement method also updates the \code{\link{tclass}} and \code{\link{tzone}} of the index to match the class and timezone of the new index, respectively. The \code{index} method converts the index to the class specified by the \code{\link{tclass}} attribute and with the timezone specified by the \code{\link{tzone}} attribute before returning the index values to the user. % #### this is not true, it returns the original object as of 2023-02-02 #### %The \code{convertIndex} function returns a modified \code{xts} object, and %\emph{does not} alter the original. The \code{.indexXXX} functions extract time components (similar to \code{\link{POSIXlt}} components) from the internal time index: \describe{ \item{\code{.indexsec}}{0 - 61: seconds of the minute (local time)} \item{\code{.indexmin}}{0 - 59: minutes of the hour (local time)} \item{\code{.indexhour}}{0 - 23: hours of the day (local time)} \item{\code{.indexDate}}{date as seconds since the epoch (UTC \emph{not local time}} \item{\code{.indexday}}{date as seconds since the epoch (UTC \emph{not local time}} \item{\code{.indexwday}}{0 - 6: day of the week (Sunday - Saturday, local time)} \item{\code{.indexmday}}{1 - 31: day of the month (local time)} \item{\code{.indexweek}}{weeks since the epoch (UTC \emph{not local time}} \item{\code{.indexmon}}{0 - 11: month of the year (local time)} \item{\code{.indexyear}}{years since 1900 (local time)} \item{\code{.indexyday}}{0 - 365: day of the year (local time, 365 only in leap years)} \item{\code{.indexisdst}}{1, 0, -1: Daylight Saving Time flag. Positive if Daylight Saving Time is in effect, zero if not, negative if unknown.} } Changes in timezone, index class, and index format internal structure, by \pkg{xts} version: \describe{ \item{Version 0.12.0:}{The \code{.indexTZ}, \code{.indexCLASS} and \code{.indexFORMAT} attributes are no longer stored on xts objects, only on the index itself. The \code{indexTZ}, \code{indexClass}, and \code{indexFormat} functions (and their respective replacement methods) are deprecated in favor of their respective \code{tzone}, \code{tclass}, and \code{tformat} versions. The previous versions will throw a warning that they're deprecated, but they will continue to work. There are no plans to remove them or have them throw an error. Ever. The latter versions are careful to look for the old attributes on the xts object, in case they're ever called on an xts object that was created prior to the attributes being added to the index itself. There are options to throw a warning if there is no \code{tzone} or \code{tclass} attribute on the index, even if there may be one on the xts object. This gives the user a way to know if an xts object should be updated to use the new structure. You can enable the warnings via: \code{options(xts.warn.index.missing.tzone = TRUE, xts.warn.index.missing.tclass = TRUE)} You can identify xts objects with the old structure by printing them. Then you can update them to the new structure using \code{x <- as.xts(x)}. } \item{Version 0.9.8:}{The index timezone is now set to "UTC" for time classes that do not have any intra-day component (e.g. days, months, quarters). Previously the timezone was blank, which meant "local time" as determined by R and the OS. } \item{Version 0.9.2:}{There are new get/set methods for the timezone, index class, and index format attributes: \code{tzone} and, \code{tzone<-}, \code{tclass} and \code{tclass<-}, and \code{tformat} and \code{tformat<-}. These new functions are aliases to their \code{indexTZ}, \code{indexClass}, and \code{indexFormat} counterparts. } \item{Version 0.7.5:}{The timezone, index class, and index format were added as attributes to the index itself, as \code{tzone}, \code{tclass}, and \code{tformat}, respectively. This is in order to remove those three attributes from the xts object, so they're only on the index itself. The \code{indexTZ}, \code{indexClass}, and \code{indexFormat} functions (and their respective replacement methods) will continue to work as in prior \pkg{xts} versions. The attributes on the index take priority over their respective counterparts that may be on the xts object. } \item{Versions 0.6.4 and prior:}{Objects track their timezone and index class in their \code{.indexTZ} and \code{.indexCLASS} attributes, respectively.} } } \seealso{ \code{\link{tformat}} describes how the index values are formatted when printed, \code{\link{tclass}} provides details how \pkg{xts} handles the class of the index, and \code{\link{tzone}} has more information about the index timezone settings. } \author{ Jeffrey A. Ryan } \examples{ x <- timeBasedSeq('2010-01-01/2010-01-01 12:00/H') x <- xts(seq_along(x), x) # the index values, converted to 'tclass' (POSIXct in this case) index(x) class(index(x)) # POSIXct tclass(x) # POSIXct # the internal numeric index .index(x) # add 1 hour (3600 seconds) to the numeric index .index(x) <- index(x) + 3600 index(x) y <- timeBasedSeq('2010-01-01/2010-01-02 12:00') y <- xts(seq_along(y), y) # Select all observations in the first 6 and last 3 minutes of the # 8th and 15th hours on each day y[.indexhour(y) \%in\% c(8, 15) & .indexmin(y) \%in\% c(0:5, 57:59)] i <- 0:60000 focal_date <- as.numeric(as.POSIXct("2018-02-01", tz = "UTC")) y <- .xts(i, c(focal_date + i * 15), tz = "UTC", dimnames = list(NULL, "value")) # Select all observations for the first minute of each hour y[.indexmin(y) == 0] # Select all observations on Monday mon <- y[.indexwday(y) == 1] head(mon) tail(mon) unique(weekdays(index(mon))) # check # Disjoint time of day selections # Select all observations between 08:30 and 08:59:59.9999 or between 12:00 and 12:14:59.99999: y[.indexhour(y) == 8 & .indexmin(y) >= 30 | .indexhour(y) == 12 & .indexmin(x) \%in\% 0:14] ### Compound selections # Select all observations for Wednesdays or Fridays between 9am and 4pm (exclusive of 4pm): y[.indexwday(y) \%in\% c(3, 5) & (.indexhour(y) \%in\% c(9:15))] # Select all observations on Monday between 8:59:45 and 09:04:30: y[.indexwday(y) == 1 & (.indexhour(y) == 8 & .indexmin(y) == 59 & .indexsec(y) >= 45 | .indexhour(y) == 9 & (.indexmin(y) < 4 | .indexmin(y) == 4 & .indexsec(y) <= 30))] i <- 0:30000 u <- .xts(i, c(focal_date + i * 1800), tz = "UTC", dimnames = list(NULL, "value")) # Select all observations for January or February: u[.indexmon(u) \%in\% c(0, 1)] # Select all data for the 28th to 31st of each month, excluding any Fridays: u[.indexmday(u) \%in\% 28:31 & .indexwday(u) != 5] # Subset by week since origin unique(.indexweek(u)) origin <- xts(1, as.POSIXct("1970-01-01")) unique(.indexweek(origin)) # Select all observations in weeks 2515 to 2517. u2 <- u[.indexweek(u) \%in\% 2515:2517] head(u2); tail(u2) # Select all observations after 12pm for day 50 and 51 in each year u[.indexyday(u) \%in\% 50:51 & .indexhour(u) >= 12] } \keyword{ts} \keyword{utilities} xts/DESCRIPTION0000644000176200001440000000227714553240732012613 0ustar liggesusersPackage: xts Type: Package Title: eXtensible Time Series Version: 0.13.2 Authors@R: c( person(given=c("Jeffrey","A."), family="Ryan", role=c("aut","cph")), person(given=c("Joshua","M."), family="Ulrich", role=c("cre","aut"), email="josh.m.ulrich@gmail.com"), person(given="Ross", family="Bennett", role="ctb"), person(given="Corwin", family="Joy", role="ctb") ) Depends: R (>= 3.6.0), zoo (>= 1.7-12) Imports: methods LinkingTo: zoo Suggests: timeSeries, timeDate, tseries, chron, tinytest LazyLoad: yes Description: Provide for uniform handling of R's different time-based data classes by extending zoo, maximizing native format information preservation and allowing for user level customization and extension, while simplifying cross-class interoperability. License: GPL (>= 2) URL: https://joshuaulrich.github.io/xts/, https://github.com/joshuaulrich/xts BugReports: https://github.com/joshuaulrich/xts/issues NeedsCompilation: yes Packaged: 2024-01-19 19:31:01 UTC; josh Author: Jeffrey A. Ryan [aut, cph], Joshua M. Ulrich [cre, aut], Ross Bennett [ctb], Corwin Joy [ctb] Maintainer: Joshua M. Ulrich Repository: CRAN Date/Publication: 2024-01-21 16:10:02 UTC xts/build/0000755000176200001440000000000014552546765012212 5ustar liggesusersxts/build/vignette.rds0000644000176200001440000000035214552546765014551 0ustar liggesusersu0+ / f,.\I$O"8~_} !D#:ՈFq ,C|F'&i1̤4Bƾ-wsD\[. */ #include #include #include SEXP do_is_ordered (SEXP x, SEXP increasing, SEXP strictly) { int i; int nx = LENGTH(x) - 1; double *real_x; int *int_x; /* If length is 0 then it is ordered */ if (nx < 0) return ScalarLogical(1); if(TYPEOF(x) == REALSXP) { /* Check for increasing order, strict or non-strict */ real_x = REAL(x); if(LOGICAL(increasing)[ 0 ] == 1) { /* INCREASING */ if(LOGICAL(strictly)[ 0 ] == 1) { /* STRICTLY INCREASING ( > 0 ) */ for(i = 0; i < nx; i++) { if( real_x[i+1] <= real_x[i] ) { return ScalarLogical(0); } } } else { /* NOT-STRICTLY ( 0 || > 0 ) */ for(i = 0; i < nx; i++) { if( real_x[i+1] < real_x[i] ) { return ScalarLogical(0); } } } /* Check for decreasing order, strict or non-strict */ } else { if(LOGICAL(strictly)[ 0 ] == 1) { /* STRICTLY DECREASING ( < 0 ) */ for(i = 0; i < nx; i++) { if( real_x[i+1] >= real_x[i] ) { return ScalarLogical(0); } } } else { /* NOT-STRICTLY ( 0 || < 0 ) */ for(i = 0; i < nx; i++) { if( real_x[i+1] > real_x[i] ) { return ScalarLogical(0); } } } } } else if(TYPEOF(x) == INTSXP) { /* Check for increasing order, strict or non-strict */ int_x = INTEGER(x); if(LOGICAL(increasing)[ 0 ] == 1) { /* INCREASING */ /* Not increasing order if first element is NA. We know x has at least 1 element. */ if( int_x[0] == NA_INTEGER ) return ScalarLogical(0); if(LOGICAL(strictly)[ 0 ] == 1) { /* STRICTLY INCREASING ( > 0 ) */ for(i = 0; i < nx; i++) { if( int_x[i+1] <= int_x[i] ) { if (i == (nx-1) && int_x[i+1] == NA_INTEGER) { continue; /* OK if NA is last element */ } return ScalarLogical(0); } } } else { /* NOT-STRICTLY ( 0 || > 0 ) */ for(i = 0; i < nx; i++) { if( int_x[i+1] < int_x[i] ) { if (i == (nx-1) && int_x[i+1] == NA_INTEGER) { continue; /* OK if NA is last element */ } return ScalarLogical(0); } } } /* Check for decreasing order, strict or non-strict */ } else { /* DECREASING */ /* Not decreasing order if last element is NA */ if( int_x[nx] == NA_INTEGER ) return ScalarLogical(0); if(LOGICAL(strictly)[ 0 ] == 1) { /* STRICTLY DECREASING ( < 0 ) */ for(i = 0; i < nx; i++) { if( int_x[i+1] >= int_x[i] ) { if (i == 0 && int_x[i] == NA_INTEGER) { continue; /* OK if NA is first element */ } return ScalarLogical(0); } } } else { /* NOT-STRICTLY ( 0 || < 0 ) */ for(i = 0; i < nx; i++) { if( int_x[i+1] > int_x[i] ) { if (i == 0 && int_x[i] == NA_INTEGER) { continue; /* OK if NA is first element */ } return ScalarLogical(0); } } } } } else { error("'x' must be of type double or integer"); } return ScalarLogical(1); /* default to true */ } xts/src/period_arithmetic.c0000644000176200001440000000427514522244666015541 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan (FORTRAN implementation) # Copyright (C) 2018 Joshua M. Ulrich (C implementation) # # 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, see . */ #include SEXP xts_period_prod(SEXP _data, SEXP _index) { if (ncols(_data) > 1) { error("single column data only"); } if (!isInteger(_index)) { error("index must be integer"); } if (!isReal(_data)) { error("data must be double"); } int i, j; int n = length(_index) - 1; SEXP _result = PROTECT(allocVector(REALSXP, n)); double *result = REAL(_result); int *index = INTEGER(_index); double *data = REAL(_data); int k = 0; for (i = 0; i < n; i++) { int idx0 = index[i]; int idx1 = index[i + 1]; double prod = data[idx0]; for (j = idx0+1; j < idx1; j++) { prod *= data[j]; } result[k++] = prod; } UNPROTECT(1); return _result; } SEXP xts_period_sum(SEXP _data, SEXP _index) { if (ncols(_data) > 1) { error("single column data only"); } if (!isInteger(_index)) { error("index must be integer"); } if (!isReal(_data)) { error("data must be double"); } int i, j; int n = length(_index) - 1; SEXP _result = PROTECT(allocVector(REALSXP, n)); double *result = REAL(_result); int *index = INTEGER(_index); double *data = REAL(_data); int k = 0; for (i = 0; i < n; i++) { int idx0 = index[i]; int idx1 = index[i + 1]; double sum = data[idx0]; for (j = idx0+1; j < idx1; j++) { sum += data[j]; } result[k++] = sum; } UNPROTECT(1); return _result; } xts/src/subset.old.c0000644000176200001440000002171614522244666014127 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ /* Base code borrowed from R's main/src/subset.c to see how to create a function to subset an xts object in it's entirety All modification are by Jeffrey A. Ryan 2008 */ #include #include #include #include "xts.h" // xtsExtractSubset {{{ static SEXP xtsExtractSubset(SEXP x, SEXP result, SEXP indx) //, SEXP call) { int i, ii, n, nx, mode; SEXP tmp, tmp2; mode = TYPEOF(x); n = LENGTH(indx); nx = length(x); tmp = result; if (x == R_NilValue) return x; for (i = 0; i < n; i++) { ii = INTEGER(indx)[i]; if (ii != NA_INTEGER) ii--; switch (mode) { case LGLSXP: if (0 <= ii && ii < nx && ii != NA_LOGICAL) LOGICAL(result)[i] = LOGICAL(x)[ii]; else LOGICAL(result)[i] = NA_LOGICAL; break; case INTSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) INTEGER(result)[i] = INTEGER(x)[ii]; else INTEGER(result)[i] = NA_INTEGER; break; case REALSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) REAL(result)[i] = REAL(x)[ii]; else REAL(result)[i] = NA_REAL; break; case CPLXSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) { COMPLEX(result)[i] = COMPLEX(x)[ii]; } else { COMPLEX(result)[i].r = NA_REAL; COMPLEX(result)[i].i = NA_REAL; } break; case STRSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) SET_STRING_ELT(result, i, STRING_ELT(x, ii)); else SET_STRING_ELT(result, i, NA_STRING); break; case VECSXP: case EXPRSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) SET_VECTOR_ELT(result, i, VECTOR_ELT(x, ii)); else SET_VECTOR_ELT(result, i, R_NilValue); break; case LISTSXP: /* cannot happen: pairlists are coerced to lists */ case LANGSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) { tmp2 = nthcdr(x, ii); SETCAR(tmp, CAR(tmp2)); SET_TAG(tmp, TAG(tmp2)); } else SETCAR(tmp, R_NilValue); tmp = CDR(tmp); break; case RAWSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) RAW(result)[i] = RAW(x)[ii]; else RAW(result)[i] = (Rbyte) 0; break; default: error("error in subset\n"); // errorcall(call, R_MSG_ob_nonsub, type2char(mode)); break; } } return result; } //}}} SEXP do_subset_xts(SEXP x, SEXP sr, SEXP sc, SEXP drop) //SEXP s, SEXP call, int drop) { SEXP attr, result, dim; int nr, nc, nrs, ncs; int i, j, ii, jj, ij, iijj; int mode; int *int_x=NULL, *int_result=NULL, *int_newindex=NULL, *int_index=NULL; double *real_x=NULL, *real_result=NULL, *real_newindex=NULL, *real_index=NULL; nr = nrows(x); nc = ncols(x); if( length(x)==0 ) return x; dim = getAttrib(x, R_DimSymbol); nrs = LENGTH(sr); ncs = LENGTH(sc); int *int_sr=NULL, *int_sc=NULL; int_sr = INTEGER(sr); int_sc = INTEGER(sc); mode = TYPEOF(x); result = allocVector(mode, nrs*ncs); PROTECT(result); if( mode==INTSXP ) { int_x = INTEGER(x); int_result = INTEGER(result); } else if( mode==REALSXP ) { real_x = REAL(x); real_result = REAL(result); } /* code to handle index of xts object efficiently */ SEXP index, newindex; int indx; index = getAttrib(x, xts_IndexSymbol); PROTECT(index); if(TYPEOF(index) == INTSXP) { newindex = allocVector(INTSXP, LENGTH(sr)); PROTECT(newindex); int_newindex = INTEGER(newindex); int_index = INTEGER(index); for(indx = 0; indx < nrs; indx++) { int_newindex[indx] = int_index[ (int_sr[indx])-1]; } copyAttributes(index, newindex); setAttrib(result, xts_IndexSymbol, newindex); UNPROTECT(1); } if(TYPEOF(index) == REALSXP) { newindex = allocVector(REALSXP, LENGTH(sr)); PROTECT(newindex); real_newindex = REAL(newindex); real_index = REAL(index); for(indx = 0; indx < nrs; indx++) { real_newindex[indx] = real_index[ (int_sr[indx])-1 ]; } copyAttributes(index, newindex); setAttrib(result, xts_IndexSymbol, newindex); UNPROTECT(1); } for (i = 0; i < nrs; i++) { ii = int_sr[i]; if (ii != NA_INTEGER) { if (ii < 1 || ii > nr) error("i is out of range\n"); ii--; } /* Begin column loop */ for (j = 0; j < ncs; j++) { //jj = INTEGER(sc)[j]; jj = int_sc[j]; if (jj != NA_INTEGER) { if (jj < 1 || jj > nc) error("j is out of range\n"); jj--; } ij = i + j * nrs; if (ii == NA_INTEGER || jj == NA_INTEGER) { switch ( mode ) { case REALSXP: real_result[ij] = NA_REAL; break; case LGLSXP: case INTSXP: int_result[ij] = NA_INTEGER; break; case CPLXSXP: COMPLEX(result)[ij].r = NA_REAL; COMPLEX(result)[ij].i = NA_REAL; break; case STRSXP: SET_STRING_ELT(result, ij, NA_STRING); break; case VECSXP: SET_VECTOR_ELT(result, ij, R_NilValue); break; case RAWSXP: RAW(result)[ij] = (Rbyte) 0; break; default: error("xts subscripting not handled for this type"); break; } } else { iijj = ii + jj * nr; switch ( mode ) { case REALSXP: real_result[ij] = real_x[iijj]; break; case LGLSXP: LOGICAL(result)[ij] = LOGICAL(x)[iijj]; break; case INTSXP: int_result[ij] = int_x[iijj]; break; case CPLXSXP: COMPLEX(result)[ij] = COMPLEX(x)[iijj]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, iijj)); break; case VECSXP: SET_VECTOR_ELT(result, ij, VECTOR_ELT(x, iijj)); break; case RAWSXP: RAW(result)[ij] = RAW(x)[iijj]; break; default: error("matrix subscripting not handled for this type"); break; } } } /* end of column loop */ } /* end of row loop */ if(nrs >= 0 && ncs >= 0 && !isNull(dim)) { PROTECT(attr = allocVector(INTSXP, 2)); INTEGER(attr)[0] = nrs; INTEGER(attr)[1] = ncs; setAttrib(result, R_DimSymbol, attr); UNPROTECT(1); } /* The matrix elements have been transferred. Now we need to */ /* transfer the attributes. Most importantly, we need to subset */ /* the dimnames of the returned value. */ if (nrs >= 0 && ncs >= 0 && !isNull(dim)) { SEXP dimnames, dimnamesnames, newdimnames; dimnames = getAttrib(x, R_DimNamesSymbol); dimnamesnames = getAttrib(dimnames, R_NamesSymbol); if (!isNull(dimnames)) { PROTECT(newdimnames = allocVector(VECSXP, 2)); if (TYPEOF(dimnames) == VECSXP) { SET_VECTOR_ELT(newdimnames, 0, xtsExtractSubset(VECTOR_ELT(dimnames, 0), allocVector(STRSXP, nrs), sr)); SET_VECTOR_ELT(newdimnames, 1, xtsExtractSubset(VECTOR_ELT(dimnames, 1), allocVector(STRSXP, ncs), sc)); } else { SET_VECTOR_ELT(newdimnames, 0, xtsExtractSubset(CAR(dimnames), allocVector(STRSXP, nrs), sr)); SET_VECTOR_ELT(newdimnames, 1, xtsExtractSubset(CADR(dimnames), allocVector(STRSXP, ncs), sc)); } setAttrib(newdimnames, R_NamesSymbol, dimnamesnames); setAttrib(result, R_DimNamesSymbol, newdimnames); UNPROTECT(1); } } copyAttributes(x, result); if(ncs == 1 && LOGICAL(drop)[0]) setAttrib(result, R_DimSymbol, R_NilValue); UNPROTECT(2); return result; } xts/src/unique.time.c0000644000176200001440000000747514522244666014316 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include "xts.h" /* for coredata_xts */ SEXP make_unique (SEXP index_, SEXP eps_) { int P = 0, i; int len = length(index_); double eps = asReal(eps_); if (TYPEOF(index_) == INTSXP) { PROTECT(index_ = coerceVector(index_, REALSXP)); P++; } SEXP newindex_ = PROTECT(allocVector(REALSXP, len)); P++; copyAttributes(index_, newindex_); double *newindex_real = REAL(newindex_); memcpy(REAL(newindex_), REAL(index_), len * sizeof(double)); double last_index = newindex_real[0]; int warn_once = 1; for(i=1; i. */ #include #include #include #include "xts.h" SEXP lagXts(SEXP x, SEXP k, SEXP pad) { SEXP result; int nrs, ncs; int i, j, ij, iijj, K, NApad; int mode; int P=0; /*PROTECT counter*/ int *int_result=NULL, *int_x=NULL; int *lgl_result=NULL, *lgl_x=NULL; double *real_result=NULL, *real_x=NULL; int *int_oindex=NULL, *int_nindex=NULL; double *real_oindex=NULL, *real_nindex=NULL; nrs = nrows(x); ncs = ncols(x); K = INTEGER(k)[ 0 ]; K = (K > nrs) ? nrs : K; mode = TYPEOF(x); NApad = INTEGER(pad)[ 0 ]; if(NApad) { PROTECT(result = allocVector(TYPEOF(x), nrs*ncs)); P++; } else { if(K > 0) { PROTECT(result = allocVector(TYPEOF(x), (nrs-K)*ncs)); P++; } else { PROTECT(result = allocVector(TYPEOF(x), (nrs+K)*ncs)); P++; } } switch( TYPEOF(x) ) { case LGLSXP: lgl_x = LOGICAL(x); lgl_result = LOGICAL(result); break; case INTSXP: int_x = INTEGER(x); int_result = INTEGER(result); break; case REALSXP: real_x = REAL(x); real_result = REAL(result); break; case CPLXSXP: case STRSXP: case VECSXP: case RAWSXP: break; default: error("unsupported type"); break; } for(i = 0; i < nrs; i++) { /* need to figue out how many duplicate values we have, in order to know how far to go back. probably best accomplished with some sort of look-ahead approach, though this may be messy if k is negative... something like: while( i+tmp+K < nrs && xindex[i] == xindex[i+tmp_K] ) tmp_K++; */ for(j = 0; j < ncs; j++) { ij = i + j * nrs; if(i < K || (K < 0 && i > (nrs+K-1)) ) { /* Pad NA values at beginning */ if(NApad) { switch ( mode ) { case LGLSXP: lgl_result[ ij ] = NA_INTEGER; break; case INTSXP: int_result[ ij ] = NA_INTEGER; break; case REALSXP: real_result[ ij ] = NA_REAL; break; case CPLXSXP: COMPLEX(result)[ij].r = NA_REAL; COMPLEX(result)[ij].i = NA_REAL; break; case STRSXP: SET_STRING_ELT(result, ij, NA_STRING); break; case VECSXP: SET_VECTOR_ELT(result, ij, R_NilValue); break; case RAWSXP: RAW(result)[ij] = (Rbyte) 0; break; default: error("matrix subscripting not handled for this type"); break; } /* NA insertion */ } /* NApad */ } else { iijj = i - K + j * nrs; /* move back K positions to get data */ if(!NApad && K > 0) ij = i - K + j * (nrs - K); /* if not padding, start at the correct spot */ if(!NApad && K < 0) ij = i + j * (nrs + K); /* if not padding, start at the correct spot */ switch ( mode ) { case LGLSXP: lgl_result[ ij ] = lgl_x[ iijj ]; break; case INTSXP: int_result[ ij ] = int_x[ iijj ]; break; case REALSXP: real_result[ ij ] = real_x[ iijj ]; break; case CPLXSXP: COMPLEX(result)[ij] = COMPLEX(x)[iijj]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, iijj)); break; case VECSXP: SET_VECTOR_ELT(result, ij, VECTOR_ELT(x, iijj)); break; case RAWSXP: RAW(result)[ij] = RAW(x)[iijj]; break; default: error("matrix subscripting not handled for this type"); break; } } } /* j-loop */ } /* i-loop */ setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); if(!NApad) { /* No NA padding */ SEXP oindex, nindex, dims; int nRows = (K > 0) ? nrs-K : nrs+K; int incr = (K > 0) ? K : 0; PROTECT(oindex = getAttrib(x, xts_IndexSymbol)); PROTECT(nindex = allocVector(TYPEOF(oindex), nRows)); switch(TYPEOF(oindex)) { case REALSXP: real_oindex = REAL(oindex); real_oindex = real_oindex + incr; real_nindex = REAL(nindex); for( i = 0; i < nRows; real_nindex++, real_oindex++, i++) *real_nindex = *real_oindex; break; case INTSXP: int_oindex = INTEGER(oindex); int_oindex = int_oindex + incr; int_nindex = INTEGER(nindex); for( i = 0; i < nRows; int_nindex++, int_oindex++, i++) *int_nindex = *int_oindex; break; default: break; } setAttrib(result, xts_IndexSymbol, nindex); PROTECT(dims = allocVector(INTSXP, 2)); INTEGER(dims)[0] = nRows; INTEGER(dims)[1] = ncs; setAttrib(result, R_DimSymbol, dims); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); UNPROTECT(3); } else { /* NA pad */ setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol)); setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol)); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); } setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); UNPROTECT(P); return result; } SEXP lag_xts (SEXP x, SEXP _k, SEXP _pad) { /* this will eventually revert to NOT changing R default behaviors for now it uses the 'standard' convention adopted by xts */ int k = asInteger(_k); /* ensure args are correct types; error if conversion fails */ if(k == NA_INTEGER) error("'k' must be integer"); if(asLogical(_pad) == NA_LOGICAL) error("'na.pad' must be logical"); k = k * -1; /* change zoo default negative handling */ return zoo_lag (x, ScalarInteger(k), _pad); } SEXP lagts_xts (SEXP x, SEXP _k, SEXP _pad) { /* this will use positive values of lag for carrying forward observations i.e. y = lagts(x, 1) is y(t) = x(t-1) */ int k = asInteger(_k)*-1; /* change zoo default negative handling */ /* ensure args are correct types; error if conversion fails */ if(k == NA_INTEGER) error("'k' must be integer"); if(asLogical(_pad) == NA_LOGICAL) error("'na.pad' must be logical"); return zoo_lag (x, ScalarInteger(k), _pad); } xts/src/isXts.c0000644000176200001440000000323114522244666013147 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include "xts.h" SEXP isXts(SEXP x) { int i; SEXP attr, index; index = getAttrib(x, xts_IndexSymbol); PROTECT( attr = coerceVector(getAttrib(x, R_ClassSymbol),STRSXP) ); if(length(attr) <= 1) { UNPROTECT(1); return Rf_ScalarInteger(0); } for(i = 0; i < length(attr); i++) { if(STRING_ELT(attr, i) == mkChar("xts")) { /* check for index attribute */ if(TYPEOF(index)==REALSXP || TYPEOF(index)==INTSXP) { UNPROTECT(1); return Rf_ScalarInteger(1); } else { UNPROTECT(1); return Rf_ScalarInteger(0); } } } UNPROTECT(1); return Rf_ScalarInteger(FALSE); } /* test function and example */ SEXP test_isXts(SEXP x) { if(Rf_asInteger(isXts(x))) { Rprintf("TRUE\n"); } else { Rprintf("FALSE\n"); } return R_NilValue; } xts/src/toperiod.c0000644000176200001440000002026514522244666013670 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ /* Possible solution to allow for a generalized single function might be to pass in a vector of available 'actions': {0=first, 1=max, 2=min, 3=last, 4=sum} This would lead to OHLC to have: 0,1,2,3 [,4[,3]] The current algorithm is in 3 stages per endpoint interation: Stage 1: Calculate first (0) of each column, this is the Op and set Hi and Lo to this value Stage 2: Cycle through all x[j] where j is ep[i]:ep[i+1] and i is 1:NROW(ep) Keep running min, max, and summation (Lo, Hi, "Volume") Stage 3: Get last value for close. Repeat for next endpoint */ #include #include /*#include */ #include "xts.h" #ifndef MAX #define MAX(a,b) (a > b ? a : b) #endif #ifndef MIN #define MIN(a,b) (a < b ? a : b) #endif SEXP toPeriod(SEXP x, SEXP endpoints, SEXP hasVolume, SEXP whichVolume, SEXP hasAdjusted, SEXP first, SEXP colnames) { SEXP result, ohlc, xindex, newindex, dimnames; int i, j=0, nrx, ncx, ncr, n, P=0; nrx = nrows(x); ncx = ncols(x); n = nrows(endpoints) - 1; ncr = 4; /* OHLC */ int mode = TYPEOF(x); int Hi, Lo, Cl, Vo; if(ncx >= 4) { /* needs OHLC or bust, clearly not the best solution since we can't just skip over columns */ Hi=1; Lo=2; Cl=3; } else { Hi=Lo=Cl=0; } if(INTEGER(hasVolume)[0]) ncr++; /* Volume */ if(INTEGER(hasAdjusted)[0]) ncr++; /* Adjusted (Yahoo) */ /* handle index values in xts */ PROTECT(xindex = getAttrib(x, xts_IndexSymbol)); P++; int index_mode = TYPEOF(xindex); PROTECT(newindex = allocVector(index_mode, n)); P++; PROTECT(result = allocVector(mode, n * ncr )); P++; PROTECT(ohlc = allocVector(mode, 6)); P++; int _FIRST = (INTEGER(first)[0]); int *ohlc_int = NULL, *result_int = NULL, *x_int = NULL; double *ohlc_real = NULL, *result_real = NULL, *x_real = NULL; switch(mode) { case INTSXP: ohlc_int = INTEGER(ohlc); result_int = INTEGER(result); x_int = INTEGER(x); break; case REALSXP: ohlc_real = REAL(ohlc); result_real = REAL(result); x_real = REAL(x); break; default: error("unsupported type"); } int *_endpoints = INTEGER(endpoints); int _hasAdjusted = INTEGER(hasAdjusted)[0]; int _hasVolume = INTEGER(hasVolume)[0]; /* volume column number */ Vo = _hasVolume ? asInteger(whichVolume)-1 : 0; for(i = 0; i < n; i++) { j = _endpoints[i]; if(_FIRST) { switch(index_mode) { case INTSXP: INTEGER(newindex)[i] = INTEGER(xindex)[j]; break; case REALSXP: REAL(newindex)[i] = REAL(xindex)[j]; break; } } /* set the Open, and initialize High, Low and Volume */ switch(mode) { case INTSXP: ohlc_int[0] = x_int[j]; /* Op */ ohlc_int[1] = x_int[j + Hi*nrx]; /* Hi */ ohlc_int[2] = x_int[j + Lo*nrx]; /* Lo */ if(_hasVolume) ohlc_int[4] = (int)0; /* Vo */ break; case REALSXP: ohlc_real[0] = x_real[j]; /* Op */ ohlc_real[1] = x_real[j + Hi*nrx]; /* Hi */ ohlc_real[2] = x_real[j + Lo*nrx]; /* Lo */ if(_hasVolume) ohlc_real[4] = (double)0; /* Vo */ break; } // set the High, Low, and Volume switch(mode) { case INTSXP: for( ; j < _endpoints[i+1]; j++) { ohlc_int[1] = MAX(ohlc_int[1], x_int[j + Hi*nrx]); /* HI */ ohlc_int[2] = MIN(ohlc_int[2], x_int[j + Lo*nrx]); /* LO */ if(_hasVolume) ohlc_int[4] = ohlc_int[4] + x_int[j + Vo*nrx]; /* VO */ } break; case REALSXP: for( ; j < _endpoints[i+1]; j++) { ohlc_real[1] = MAX(ohlc_real[1], x_real[j + Hi*nrx]); /* HI */ ohlc_real[2] = MIN(ohlc_real[2], x_real[j + Lo*nrx]); /* LO */ if(_hasVolume) { ohlc_real[4] = ohlc_real[4] + x_real[j + Vo*nrx]; /* VO */ } } break; } /* set the Close and Adjusted columns */ /* Rprintf("i,j: %i,%i\t",i,j); */ j--; switch(mode) { case INTSXP: ohlc_int[3] = x_int[j + Cl*nrx]; if(_hasAdjusted) ohlc_int[5] = x_int[j + 5*nrx]; break; case REALSXP: ohlc_real[3] = x_real[j + Cl*nrx]; if(_hasAdjusted) ohlc_real[5] = x_real[j + 5*nrx]; break; } if(!_FIRST) { /* index at last position */ switch(index_mode) { case INTSXP: INTEGER(newindex)[i] = INTEGER(xindex)[j]; break; case REALSXP: REAL(newindex)[i] = REAL(xindex)[j]; break; } } /* switch(mode) { case INTSXP: INTEGER(result)[i] = ohlc_int[0]; INTEGER(result)[i+1*n] = ohlc_int[1]; INTEGER(result)[i+2*n] = ohlc_int[2]; INTEGER(result)[i+3*n] = ohlc_int[3]; if(_hasVolume) INTEGER(result)[i+4*n] = ohlc_int[4]; if(_hasAdjusted) INTEGER(result)[i+5*n] = ohlc_int[5]; break; case REALSXP: REAL(result)[i] = REAL(ohlc)[0]; REAL(result)[i+1*n] = REAL(ohlc)[1]; REAL(result)[i+2*n] = REAL(ohlc)[2]; REAL(result)[i+3*n] = REAL(ohlc)[3]; if(_hasVolume) REAL(result)[i+4*n] = REAL(ohlc)[4]; if(_hasAdjusted) REAL(result)[i+5*n] = REAL(ohlc)[5]; break; } */ switch(mode) { case INTSXP: result_int[i] = ohlc_int[0]; result_int[i+1*n] = ohlc_int[1]; result_int[i+2*n] = ohlc_int[2]; result_int[i+3*n] = ohlc_int[3]; if(_hasVolume) result_int[i+4*n] = ohlc_int[4]; if(_hasAdjusted) result_int[i+5*n] = ohlc_int[5]; break; case REALSXP: result_real[i] = ohlc_real[0]; result_real[i+1*n] = ohlc_real[1]; result_real[i+2*n] = ohlc_real[2]; result_real[i+3*n] = ohlc_real[3]; if(_hasVolume) result_real[i+4*n] = ohlc_real[4]; if(_hasAdjusted) result_real[i+5*n] = ohlc_real[5]; break; } /* Rprintf("i,j: %i,%i\n",i,j); */ } SEXP dim; dim = PROTECT(allocVector(INTSXP, 2)); P++; INTEGER(dim)[0] = n; INTEGER(dim)[1] = ncr; setAttrib(result, R_DimSymbol, dim); PROTECT(dimnames = allocVector(VECSXP, 2)); P++; SET_VECTOR_ELT(dimnames, 0, R_NilValue); /* no rownames ever! */ if(!isNull(colnames)) { SET_VECTOR_ELT(dimnames, 1, colnames); } else { SEXP newcolnames; PROTECT(newcolnames = allocVector(STRSXP, ncr));P++; SET_STRING_ELT(newcolnames, 0, mkChar("Open")); SET_STRING_ELT(newcolnames, 1, mkChar("High")); SET_STRING_ELT(newcolnames, 2, mkChar("Low")); SET_STRING_ELT(newcolnames, 3, mkChar("Close")); if(INTEGER(hasVolume)[0]) SET_STRING_ELT(newcolnames, 4, mkChar("Volume")); if(INTEGER(hasAdjusted)[0]) SET_STRING_ELT(newcolnames, 5, mkChar("Adjusted")); SET_VECTOR_ELT(dimnames, 1, newcolnames); } setAttrib(result, R_DimNamesSymbol, dimnames); copyMostAttrib(xindex, newindex); setAttrib(result, xts_IndexSymbol, newindex); copy_xtsAttributes(x, result); copy_xtsCoreAttributes(x, result); UNPROTECT(P); return result; } xts/src/period_quantile.c0000644000176200001440000000440114522244666015221 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan (FORTRAN implementation) # Copyright (C) 2018 Joshua M. Ulrich (C implementation) # # 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, see . */ #include SEXP xts_period_max(SEXP _data, SEXP _index) { if (ncols(_data) > 1) { error("single column data only"); } if (!isInteger(_index)) { error("index must be integer"); } if (!isReal(_data)) { error("data must be double"); } int i, j; int n = length(_index) - 1; SEXP _result = PROTECT(allocVector(REALSXP, n)); double *result = REAL(_result); int *index = INTEGER(_index); double *data = REAL(_data); int k = 0; for (i = 0; i < n; i++) { int idx0 = index[i]; int idx1 = index[i + 1]; double max = data[idx0]; for (j = idx0+1; j < idx1; j++) { if (data[j] > max) { max = data[j]; } } result[k++] = max; } UNPROTECT(1); return _result; } SEXP xts_period_min(SEXP _data, SEXP _index) { if (ncols(_data) > 1) { error("single column data only"); } if (!isInteger(_index)) { error("index must be integer"); } if (!isReal(_data)) { error("data must be double"); } int i, j; int n = length(_index) - 1; SEXP _result = PROTECT(allocVector(REALSXP, n)); double *result = REAL(_result); int *index = INTEGER(_index); double *data = REAL(_data); int k = 0; for (i = 0; i < n; i++) { int idx0 = index[i]; int idx1 = index[i + 1]; double min = data[idx0]; for (j = idx0+1; j < idx1; j++) { if (data[j] < min) { min = data[j]; } } result[k++] = min; } UNPROTECT(1); return _result; } xts/src/subset.c0000644000176200001440000003433014522244666013346 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include "xts.h" static SEXP xts_ExtractSubset(SEXP x, SEXP result, SEXP indx) //, SEXP call) { /* ExtractSubset is currently copied/inspired by subset.c from GNU-R This is slated to be reimplemented using the previous method in xts to get the correct dimnames */ int i, ii, n, nx, mode; SEXP tmp, tmp2; mode = TYPEOF(x); n = LENGTH(indx); nx = length(x); tmp = result; /*if (x == R_NilValue)*/ if (isNull(x)) return x; for (i = 0; i < n; i++) { ii = INTEGER(indx)[i]; if (ii != NA_INTEGER) ii--; switch (mode) { case LGLSXP: if (0 <= ii && ii < nx && ii != NA_LOGICAL) LOGICAL(result)[i] = LOGICAL(x)[ii]; else LOGICAL(result)[i] = NA_LOGICAL; break; case INTSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) INTEGER(result)[i] = INTEGER(x)[ii]; else INTEGER(result)[i] = NA_INTEGER; break; case REALSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) REAL(result)[i] = REAL(x)[ii]; else REAL(result)[i] = NA_REAL; break; case CPLXSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) { COMPLEX(result)[i] = COMPLEX(x)[ii]; } else { COMPLEX(result)[i].r = NA_REAL; COMPLEX(result)[i].i = NA_REAL; } break; case STRSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) SET_STRING_ELT(result, i, STRING_ELT(x, ii)); else SET_STRING_ELT(result, i, NA_STRING); break; case VECSXP: case EXPRSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) SET_VECTOR_ELT(result, i, VECTOR_ELT(x, ii)); else SET_VECTOR_ELT(result, i, R_NilValue); break; case LISTSXP: /* cannot happen: pairlists are coerced to lists */ case LANGSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) { tmp2 = nthcdr(x, ii); SETCAR(tmp, CAR(tmp2)); SET_TAG(tmp, TAG(tmp2)); } else SETCAR(tmp, R_NilValue); tmp = CDR(tmp); break; case RAWSXP: if (0 <= ii && ii < nx && ii != NA_INTEGER) RAW(result)[i] = RAW(x)[ii]; else RAW(result)[i] = (Rbyte) 0; break; default: error("error in subset\n"); break; } } return result; } SEXP _do_subset_xts (SEXP x, SEXP sr, SEXP sc, SEXP drop) { SEXP result; int i, j, nr, nc, nrs, ncs; int P=0; SEXP Dim = getAttrib(x, R_DimSymbol); nrs = nrows(x);ncs = ncols(x); nr = length(sr); nc = length(sc); SEXP oindex, nindex; oindex = getAttrib(x, xts_IndexSymbol); PROTECT(nindex = allocVector(TYPEOF(oindex), nr)); P++; PROTECT(result = allocVector(TYPEOF(x), nr*nc)); P++; j = 0; double *real_nindex=NULL, *real_oindex, *real_result=NULL, *real_x=NULL; int *int_nindex=NULL, *int_oindex, *int_result=NULL, *int_x=NULL; int *int_sr=NULL, *int_sc=NULL; int_sr = INTEGER(sr); int_sc = INTEGER(sc); copyAttributes(x, result); if(TYPEOF(x)==LGLSXP) { int_x = LOGICAL(x); int_result = LOGICAL(result); if(TYPEOF(nindex)==INTSXP) { int_nindex = INTEGER(nindex); int_oindex = INTEGER(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) int_result[i+j*nr] = NA_INTEGER; else int_result[i+j*nr] = int_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) int_result[i+j*nr] = NA_INTEGER; else int_result[i+j*nr] = int_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); for(j=1; j nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) int_result[i+j*nr] = NA_INTEGER; else int_result[i+j*nr] = int_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) int_result[i+j*nr] = NA_INTEGER; else int_result[i+j*nr] = int_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); /* loop through remaining columns */ for(j=1; j nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) real_result[i+j*nr] = NA_REAL; else real_result[i+j*nr] = real_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) real_result[i+j*nr] = NA_REAL; else real_result[i+j*nr] = real_x[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); for(j=1; j nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) { COMPLEX(result)[i+j*nr].r = NA_REAL; COMPLEX(result)[i+j*nr].i = NA_REAL; } else COMPLEX(result)[i+j*nr] = COMPLEX(x)[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) { COMPLEX(result)[i+j*nr].r = NA_REAL; COMPLEX(result)[i+j*nr].i = NA_REAL; } else COMPLEX(result)[i+j*nr] = COMPLEX(x)[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); for(j=1; j nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) SET_STRING_ELT(result, i+j*nr, NA_STRING); else SET_STRING_ELT(result, i+j*nr, STRING_ELT(x, int_sr[i]-1 + ((int_sc[j]-1) * nrs))); } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) SET_STRING_ELT(result, i+j*nr, NA_STRING); else SET_STRING_ELT(result, i+j*nr, STRING_ELT(x, int_sr[i]-1 + ((int_sc[j]-1) * nrs))); } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); for(j=1; j nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); int_nindex[i] = int_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) RAW(result)[i+j*nr] = 0; else RAW(result)[i+j*nr] = RAW(x)[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } else if(TYPEOF(nindex)==REALSXP) { real_nindex = REAL(nindex); real_oindex = REAL(oindex); for(i=0; i nrs || int_sc[j] > ncs) error("'i' or 'j' out of range"); real_nindex[i] = real_oindex[int_sr[i]-1]; if(int_sc[j] == NA_INTEGER) RAW(result)[i+j*nr] = 0; else RAW(result)[i+j*nr] = RAW(x)[int_sr[i]-1 + ((int_sc[j]-1) * nrs)]; } } copyAttributes(oindex, nindex); setAttrib(result, xts_IndexSymbol, nindex); for(j=1; j= 0 && nc >= 0) { SEXP dim; PROTECT(dim = allocVector(INTSXP,2));P++; INTEGER(dim)[0] = nr; INTEGER(dim)[1] = nc; setAttrib(result, R_DimSymbol, dim); if (nr >= 0 && nc >= 0) { SEXP dimnames, dimnamesnames, newdimnames; dimnames = getAttrib(x, R_DimNamesSymbol); dimnamesnames = getAttrib(dimnames, R_NamesSymbol); if (!isNull(dimnames)) { PROTECT(newdimnames = allocVector(VECSXP, 2)); if (TYPEOF(dimnames) == VECSXP) { SET_VECTOR_ELT(newdimnames, 0, xts_ExtractSubset(VECTOR_ELT(dimnames, 0), allocVector(STRSXP, nr), sr)); SET_VECTOR_ELT(newdimnames, 1, xts_ExtractSubset(VECTOR_ELT(dimnames, 1), allocVector(STRSXP, nc), sc)); } else { SET_VECTOR_ELT(newdimnames, 0, xts_ExtractSubset(CAR(dimnames), allocVector(STRSXP, nr), sr)); SET_VECTOR_ELT(newdimnames, 1, xts_ExtractSubset(CADR(dimnames), allocVector(STRSXP, nc), sc)); } setAttrib(newdimnames, R_NamesSymbol, dimnamesnames); setAttrib(result, R_DimNamesSymbol, newdimnames); UNPROTECT(1); } } } setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); if(nc == 1 && LOGICAL(drop)[0]) setAttrib(result, R_DimSymbol, R_NilValue); UNPROTECT(P); return result; } xts/src/dimnames.c0000644000176200001440000000243414522244666013636 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2010 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include SEXP dimnames_zoo (SEXP x) { return(getAttrib(x, R_DimNamesSymbol)); } SEXP xts_set_dimnames (SEXP x, SEXP value) { if (R_NilValue == value) { setAttrib(x, R_DimNamesSymbol, R_NilValue); } else { if (TYPEOF(value) != VECSXP || length(value) != 2) { error("invalid 'dimnames' given for xts"); } /* xts objects never have row names */ SET_VECTOR_ELT(value, 0, R_NilValue); setAttrib(x, R_DimNamesSymbol, value); } return x; } xts/src/init.c0000644000176200001440000001457414522244666013014 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 - 2013 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich and Dirk Eddelbuettel # # 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, see . */ #include "xts.h" #include #include #include static const R_CallMethodDef callMethods[] = { {"add_class", (DL_FUNC) &add_class, 2}, {"coredata_xts", (DL_FUNC) &coredata_xts, 1}, {"do_xtsAttributes", (DL_FUNC) &do_xtsAttributes, 1}, {"add_xtsCoreAttributes", (DL_FUNC) &add_xtsCoreAttributes, 6}, {"lag_xts", (DL_FUNC) &lag_xts, 3}, {"lagXts", (DL_FUNC) &lagXts, 3}, {"do_is_ordered", (DL_FUNC) &do_is_ordered, 3}, {"isXts", (DL_FUNC) &isXts, 1}, {"tryXts", (DL_FUNC) &tryXts, 1}, {"na_locf", (DL_FUNC) &na_locf, 4}, {"na_omit_xts", (DL_FUNC) &na_omit_xts, 1}, {"do_rbind_xts", (DL_FUNC) &do_rbind_xts, 3}, {"_do_subset_xts", (DL_FUNC) &_do_subset_xts, 4}, {"do_merge_xts", (DL_FUNC) &do_merge_xts, 11}, {"naCheck", (DL_FUNC) &naCheck, 2}, {"make_index_unique", (DL_FUNC) &make_index_unique, 2}, {"make_unique", (DL_FUNC) &make_unique, 2}, {"any_negative", (DL_FUNC) &any_negative, 1}, {"extract_col", (DL_FUNC) &extract_col, 5}, {"binsearch", (DL_FUNC) &binsearch, 3}, {"fill_window_dups_rev", (DL_FUNC) &fill_window_dups_rev, 2}, {"non_duplicates", (DL_FUNC) &non_duplicates, 2}, {"roll_min", (DL_FUNC) &roll_min, 2}, {"roll_max", (DL_FUNC) &roll_max, 2}, {"roll_sum", (DL_FUNC) &roll_sum, 2}, {"roll_cov", (DL_FUNC) &roll_cov, 4}, {"toPeriod", (DL_FUNC) &toPeriod, 7}, {"xts_period_apply", (DL_FUNC) &xts_period_apply, 4}, {"xts_period_min", (DL_FUNC) &xts_period_min, 2}, {"xts_period_max", (DL_FUNC) &xts_period_max, 2}, {"xts_period_sum", (DL_FUNC) &xts_period_sum, 2}, {"xts_period_prod", (DL_FUNC) &xts_period_prod, 2}, {"endpoints", (DL_FUNC) &endpoints, 4}, {"dimnames_zoo", (DL_FUNC) &dimnames_zoo, 1}, {"xts_set_dimnames", (DL_FUNC) &xts_set_dimnames, 2}, {"do_startofyear", (DL_FUNC) &do_startofyear, 3}, {NULL, NULL, 0} }; static const R_ExternalMethodDef externalMethods[] = { {"number_of_cols", (DL_FUNC) &number_of_cols, -1}, {"mergeXts", (DL_FUNC) &mergeXts, -1}, {"rbindXts", (DL_FUNC) &rbindXts, -1}, {NULL, NULL, 0} }; /* define globals */ SEXP xts_IndexSymbol; SEXP xts_ClassSymbol; SEXP xts_IndexTformatSymbol; SEXP xts_IndexTclassSymbol; SEXP xts_IndexTzoneSymbol; /* define imports from zoo */ SEXP (*zoo_lag)(SEXP,SEXP,SEXP); SEXP (*zoo_coredata)(SEXP,SEXP); /* * Taken from R/src/main/names.c * "Set up a set of globals so that a symbol table search can be * avoided when matching something like dim or dimnames." * * This also prevents flags from rchk's maacheck (Multiple-Allocating- * Arguments) tool for calls like: * setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol)); */ static void SymbolShortcuts(void) { xts_IndexSymbol = install("index"); xts_ClassSymbol = install(".CLASS"); xts_IndexTformatSymbol = install("tformat"); xts_IndexTclassSymbol = install("tclass"); xts_IndexTzoneSymbol = install("tzone"); } void R_init_xts(DllInfo *info) { SymbolShortcuts(); R_registerRoutines(info, NULL, callMethods, NULL, externalMethods); R_useDynamicSymbols(info, FALSE); R_forceSymbols(info, TRUE); /* used by external packages linking to internal xts code from C */ R_RegisterCCallable("xts","do_is_ordered",(DL_FUNC) &do_is_ordered); R_RegisterCCallable("xts","coredata_xts", (DL_FUNC) &coredata_xts); R_RegisterCCallable("xts","isXts", (DL_FUNC) &isXts); R_RegisterCCallable("xts","tryXts", (DL_FUNC) &tryXts); R_RegisterCCallable("xts","do_rbind_xts", (DL_FUNC) &do_rbind_xts); R_RegisterCCallable("xts","naCheck", (DL_FUNC) &naCheck); R_RegisterCCallable("xts","lagXts", (DL_FUNC) &lagXts); R_RegisterCCallable("xts","make_index_unique", (DL_FUNC) &make_index_unique); R_RegisterCCallable("xts","make_unique", (DL_FUNC) &make_unique); R_RegisterCCallable("xts","endpoints", (DL_FUNC) &endpoints); R_RegisterCCallable("xts","do_merge_xts", (DL_FUNC) &do_merge_xts); R_RegisterCCallable("xts","na_omit_xts", (DL_FUNC) &na_omit_xts); R_RegisterCCallable("xts","na_locf", (DL_FUNC) &na_locf); R_RegisterCCallable("xts","xts_period_min", (DL_FUNC) &xts_period_min); R_RegisterCCallable("xts","xts_period_max", (DL_FUNC) &xts_period_max); R_RegisterCCallable("xts","xts_period_sum", (DL_FUNC) &xts_period_sum); R_RegisterCCallable("xts","xts_period_prod", (DL_FUNC) &xts_period_prod); R_RegisterCCallable("xts","xts_set_dimnames", (DL_FUNC) &xts_set_dimnames); /* used by xts (functions moved from xts to zoo) */ zoo_lag = (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("zoo","zoo_lag"); zoo_coredata = (SEXP(*)(SEXP,SEXP)) R_GetCCallable("zoo","zoo_coredata"); } xts/src/attr.c0000644000176200001440000001233414522244666013013 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include "xts.h" SEXP do_xtsAttributes(SEXP x) { SEXP a, values, names; int i=0, P=0; a = ATTRIB(x); if(length(a) <= 0) return R_NilValue; PROTECT(a); P++; /* all attributes */ PROTECT(values = allocVector(VECSXP, length(a))); P++; PROTECT(names = allocVector(STRSXP, length(a))); P++; /* CAR gets the first element of the dotted pair list CDR gets the rest of the dotted pair list TAG gets the symbol/name of the first element of dotted pair list */ for( /* a=ATTRIB(a) */; a != R_NilValue; a = CDR(a) ) { if(TAG(a) != xts_IndexSymbol && TAG(a) != xts_ClassSymbol && TAG(a) != R_ClassSymbol && TAG(a) != R_DimSymbol && TAG(a) != R_DimNamesSymbol && TAG(a) != R_NamesSymbol) { SET_VECTOR_ELT(values, i, CAR(a)); SET_STRING_ELT(names, i, PRINTNAME(TAG(a))); i++; } } if(i == 0) { UNPROTECT(P); return R_NilValue; } /* truncate list back to i-size */ PROTECT(values = lengthgets(values, i)); P++; PROTECT(names = lengthgets(names, i)); P++; setAttrib(values, R_NamesSymbol, names); UNPROTECT(P); return values; } SEXP do_xtsCoreAttributes(SEXP x) { SEXP a, values, names; int i=0, P=0; a = ATTRIB(x); if(length(a) <= 0) return R_NilValue; PROTECT(a); P++; /* all attributes */ PROTECT(values = allocVector(VECSXP, length(a))); P++; PROTECT(names = allocVector(STRSXP, length(a))); P++; /* CAR gets the first element of the dotted pair list CDR gets the rest of the dotted pair list TAG gets the symbol/name of the first element of dotted pair list */ for( /* a=ATTRIB(a) */; a != R_NilValue; a = CDR(a) ) { if(TAG(a) == xts_ClassSymbol || TAG(a) == R_ClassSymbol) { SET_VECTOR_ELT(values, i, CAR(a)); SET_STRING_ELT(names, i, PRINTNAME(TAG(a))); i++; } } if(i == 0) { UNPROTECT(P); return R_NilValue; } /* truncate list back to i-size */ PROTECT(values = lengthgets(values, i)); P++; PROTECT(names = lengthgets(names, i)); P++; setAttrib(values, R_NamesSymbol, names); UNPROTECT(P); return values; } void copyAttributes(SEXP x, SEXP y) { /* similar to copyMostAttr except that we add index to the list of attributes to exclude */ SEXP attr; int P=0; attr = ATTRIB(x); /* this returns a LISTSXP */ if(length(attr) > 0 || y != R_NilValue) { PROTECT(attr); P++; for( ; attr != R_NilValue; attr = CDR(attr) ) { if( (TAG(attr) != xts_IndexSymbol) && (TAG(attr) != R_DimSymbol) && (TAG(attr) != R_DimNamesSymbol) && (TAG(attr) != R_NamesSymbol) ) { setAttrib(y, TAG(attr), CAR(attr)); } } UNPROTECT(P); } } void copy_xtsAttributes(SEXP x, SEXP y) { SEXP attr; int P=0; attr = PROTECT(do_xtsAttributes(x)); P++; attr = PROTECT(coerceVector(attr, LISTSXP)); P++; if(length(attr) > 0 || y != R_NilValue) { for( ; attr != R_NilValue; attr = CDR(attr) ) { setAttrib(y, TAG(attr), CAR(attr)); } } UNPROTECT(P); } void copy_xtsCoreAttributes(SEXP x, SEXP y) { SEXP attr; int P=0; attr = PROTECT(do_xtsCoreAttributes(x)); P++; attr = PROTECT(coerceVector(attr, LISTSXP)); P++; if(length(attr) > 0 || y != R_NilValue) { for( ; attr != R_NilValue; attr = CDR(attr) ) { setAttrib(y, TAG(attr), CAR(attr)); } } UNPROTECT(P); } SEXP ca (SEXP x, SEXP y) { /* an example of internal copying of user-defined xts attributes this will be used inside of do_xts_subset and do_xts_merge This particular usage is bad, as y is modified without copying resulting in all y and reference to y within R envir being altered the 'y' should only be the new value that is to be returned */ copy_xtsAttributes(x,y); return R_NilValue; } SEXP add_xtsCoreAttributes(SEXP _x, SEXP _index, SEXP _tzone, SEXP _tclass, SEXP _class, SEXP _tformat) { int P=0; if(MAYBE_SHARED(_index)) { PROTECT(_index = duplicate(_index)); P++; } /* add tzone and tclass to index */ setAttrib(_index, xts_IndexTclassSymbol, _tclass); setAttrib(_index, xts_IndexTzoneSymbol, _tzone); setAttrib(_index, xts_IndexTformatSymbol, _tformat); if(MAYBE_SHARED(_x)) { PROTECT(_x = duplicate(_x)); P++; //_x = duplicate(_x); } setAttrib(_x, xts_IndexSymbol, _index); /* index */ setAttrib(_x, R_ClassSymbol, _class); /* class */ UNPROTECT(P); return(_x); } xts/src/rollfun.c0000644000176200001440000003124414522244666013523 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include "xts.h" /* http://en.wikipedia.org/wiki/Kahan_summation_algorithm * sum += x, and updates the accumulated error "c" */ void kahan_sum(long double x, long double * c, long double * sum) { /* Author: Ivan Popivanov */ long double y = x - *c; long double t = *sum + y; *c = ( t - *sum ) - y; *sum = t; } SEXP roll_sum (SEXP x, SEXP n) { /* Author: Joshua Ulrich, with contributions from Ivan Popivanov */ int i, P=0, nrs; nrs = nrows(x); /* Get values from pointers */ int int_n = asInteger(n); /* Initalize result R object */ SEXP result; PROTECT(result = allocVector(TYPEOF(x), length(x))); P++; int *int_result=NULL, *int_x=NULL; int int_sum = 0; double *real_result=NULL, *real_x=NULL; /* check for non-leading NAs and get first non-NA location */ SEXP first; PROTECT(first = naCheck(x, ScalarLogical(TRUE))); P++; int int_first = asInteger(first); if(int_n + int_first > nrs) error("not enough non-NA values"); long double sum = 0.0; long double comp = 0.0; switch(TYPEOF(x)) { case REALSXP: real_result = REAL(result); real_x = REAL(x); //int_result = int_x = NULL; /* set leading NAs, find initial sum value */ for(i=0; i= int_first) kahan_sum(real_x[i], &comp, &sum); } real_result[ int_n + int_first - 1 ] = (double)sum; /* loop over all other values */ for(i=int_n+int_first; i= int_first) int_sum += int_x[i]; } int_result[ int_n + int_first -1 ] = int_sum; /* loop over all other values */ for(i=int_n+int_first; i nrs) error("not enough non-NA values"); /* The branch by type allows for fewer type checks/branching * within the algorithm, providing a _much_ faster mechanism */ switch(TYPEOF(x)) { /* need to implement other types (checking)? */ case REALSXP: real_result = REAL(result); real_x = REAL(x); real_min = real_x[0]; loc = 0; for(i=0; i= int_n-1) { /* find the min over the entire window */ real_min = real_x[i]; for(j=0; j= int_n - 1) { /* find the min over the entire window */ int_min = int_x[i]; for(j=0; j nrs) error("not enough non-NA values"); /* The branch by type allows for fewer type checks/branching * within the algorithm, providing a _much_ faster mechanism */ switch(TYPEOF(x)) { /* need to implement other types (checking)? */ case REALSXP: real_result = REAL(result); real_x = REAL(x); real_max = real_x[0]; loc = 0; for(i=0; i real_max) { real_max = real_x[i]; /* set min value */ loc = 0; /* set min location in window */ } loc++; continue; } else { /* if the min leaves the window */ if(loc >= int_n-1) { /* find the min over the entire window */ real_max = real_x[i]; for(j=0; j real_max) { real_max = real_x[i-j]; loc = j; } } } else { /* if the new value is the new min */ if(real_x[i] > real_max) { real_max = real_x[i]; loc = 0; } } } /* set result, increment location */ real_result[i] = real_max; loc++; } break; case INTSXP: int_result = INTEGER(result); int_x = INTEGER(x); int_min = int_x[0]; loc = 0; for(i=0; i int_min) { int_min = int_x[i]; /* set min value */ loc = 0; /* set min location in window */ } loc++; continue; } else { /* if the min leaves the window */ if(loc >= int_n - 1) { /* find the min over the entire window */ int_min = int_x[i]; for(j=0; j int_min) { int_min = int_x[i-j]; loc = j; } } } else { /* if the new value is the new min */ if(int_x[i] > int_min) { int_min = int_x[i]; loc = 0; } } } /* set result, increment location */ int_result[i] = int_min; loc++; } break; /* case STRSXP: fail! case LGLSXP: convert to int?? case CPLXSXP: */ default: error("unsupported data type"); } copyMostAttrib(x, result); /* still need to set dims and dimnames */ setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol)); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); UNPROTECT(P); return result; } SEXP roll_cov (SEXP x, SEXP y, SEXP n, SEXP samp) { /* Author: Joshua Ulrich */ int i, P=0; /* ensure x and y have same length in R functions, since it's * easier to throw user-informative errors */ int nrx = nrows(x); int nry = nrows(y); if(nrx != nry) error("nrx != nry, blame the R function writer"); /* Coerce to REALSXP to ensure roll_sum returns REALSXP */ PROTECT(x = coerceVector(x, REALSXP)); P++; PROTECT(y = coerceVector(y, REALSXP)); P++; /* Get values from function arguments */ double *real_x = REAL(PROTECT(coerceVector(x, REALSXP))); P++; double *real_y = REAL(PROTECT(coerceVector(y, REALSXP))); P++; int int_n = asInteger(n); int int_samp = asLogical(samp); /* Initalize result R object */ SEXP result; PROTECT(result = allocVector(REALSXP, nrx)); P++; double *real_result = REAL(result); /* rolling sums for mean calculation */ SEXP sum_x, sum_y, xy, sum_xy; PROTECT(sum_x = roll_sum(x, n)); P++; PROTECT(sum_y = roll_sum(y, n)); P++; double *real_sum_x = REAL(sum_x); double *real_sum_y = REAL(sum_y); /* rolling sum of x * y */ PROTECT(xy = allocVector(REALSXP, nrx)); P++; double *real_xy = REAL(xy); for(i=nrx; i--;) { real_xy[i] = real_x[i] * real_y[i]; } PROTECT(sum_xy = roll_sum(xy, n)); P++; double *real_sum_xy = REAL(sum_xy); /* check for non-leading NAs and get first non-NA location */ SEXP first; PROTECT(first = naCheck(sum_xy, ScalarLogical(TRUE))); P++; int int_first = asInteger(first); if(int_n + int_first > nrx) error("not enough non-NA values"); /* set leading NAs */ for(i=0; i. */ /***********************************************************************/ /* xts, copyright (C) Jeffrey A. Ryan, 2008 */ // // experimental code to provide rollapply functionality to standard // functions. Essentially a .Call port of Josh's run*** functions // from TTR. Though it should be obvious these are a lot more complex. // // runSum, runMin, runMax, runMedian, runMean, runSD // /***********************************************************************/ #include #include #include "xts.h" /* SEXP do_runsum (SEXP x, SEXP n, SEXP result) { } SEXP do_run (SEXP x, SEXP n, (*void)FUN) { SEXP result; int P=0; int i, nrs; int *int_n=NULL; if(TYPEOF(n) != INTSXP) { // assure that 'n' is an integer PROTECT(n = coerceVector(n, INTSXP)); P++; } int_n = INTEGER(n); // get the first element (everything from R is a vector) int *int_result=NULL, *int_x=NULL; int int_sum = 0; double *real_result=NULL, *real_x=NULL; double real_sum = 0.0; PROTECT(result = allocVector(TYPEOF(x), length(x))); P++; int _firstNonNA = firstNonNA(x); } */ SEXP runSum (SEXP x, SEXP n) { SEXP result; int P=0; int i, nrs; int *int_n=NULL; if(TYPEOF(n) != INTSXP) { // assure that 'n' is an integer PROTECT(n = coerceVector(n, INTSXP)); P++; } int_n = INTEGER(n); // get the first element (everything from R is a vector) int *int_result=NULL, *int_x=NULL; int int_sum = 0; double *real_result=NULL, *real_x=NULL; double real_sum = 0.0; PROTECT(result = allocVector(TYPEOF(x), length(x))); P++; int _firstNonNA = firstNonNA(x); switch(TYPEOF(x)) { /* still need to implement other types, and checking // The branch by type allows for fewer type checks/branching // within the algorithm, providing a _much_ faster mechanism // to calculate the sum // // This part of the code should probably be a function // call to a function pointer passed in to the top-level // call... maybe??? // This should make it easier to extend the framework // and _more_ importantly allow for user-level C // functions (via R) to be used ad hoc */ case REALSXP: real_result = REAL(result); real_x = REAL(x); int_result = int_x = NULL; for(i = 0; i < (*int_n)+_firstNonNA; i++) { real_result[i] = NA_REAL; if(i >= _firstNonNA) real_sum = real_sum + real_x[i]; } real_result[ (*int_n) + _firstNonNA - 1 ] = real_sum; nrs = nrows(x); for(i = (*int_n)+_firstNonNA; i < nrs; i++) { if(ISNA(real_x[i]) || ISNAN(real_x[i])) error("Series contains non-leading NAs"); real_result[i] = real_result[i-1] + real_x[i] - real_x[i-(*int_n)]; } break; case INTSXP: int_result = INTEGER(result); int_x = INTEGER(x); real_result = real_x = NULL; for(i = 0; i < (*int_n)+_firstNonNA; i++) { // (*int_n) is faster that INTEGER(n)[1], a constant would be equal int_result[i] = NA_INTEGER; if(i >= _firstNonNA) int_sum = int_sum + int_x[i]; } int_result[ (*int_n) + _firstNonNA -1 ] = int_sum; nrs = nrows(x); for(i = (*int_n)+_firstNonNA; i < nrs; i++) { if(int_x[i]==NA_INTEGER) error("Series contains non-leading NAs"); int_result[i] = int_result[i-1] + int_x[i] - int_x[i-(*int_n)]; } break; /* case STRSXP: fail! case LGLSXP: convert to int?? case CPLXSXP: */ } setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol)); setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol)); UNPROTECT(P); return result; } xts/src/na.c0000644000176200001440000003700314522244666012437 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include "xts.h" /* Internal use only * called by: firstNonNA, naCheck, na_locf */ static int firstNonNACol (SEXP x, int col) { int i=0, nr; int *int_x=NULL; double *real_x=NULL; nr = nrows(x); if(col > ncols(x)-1 || col < 0L) error("column out of range"); switch(TYPEOF(x)) { case LGLSXP: int_x = LOGICAL(x); for(i=0+col*nr; i<(nr+col*nr); i++) { if(int_x[i]!=NA_LOGICAL) { break; } } break; case INTSXP: int_x = INTEGER(x); for(i=0+col*nr; i<(nr+col*nr); i++) { if(int_x[i]!=NA_INTEGER) { break; } } break; case REALSXP: real_x = REAL(x); for(i=0+col*nr; i<(nr+col*nr); i++) { if(!ISNA(real_x[i]) && !ISNAN(real_x[i])) { break; } } break; case STRSXP: for(i=0+col*nr; i<(nr+col*nr); i++) { if(STRING_ELT(x, i)!=NA_STRING) { break; } } break; default: error("unsupported type"); break; } return(i); } /* Should be internal use only (static), but is in xts.h */ int firstNonNA (SEXP x) { return firstNonNACol(x, 0); } SEXP naCheck (SEXP x, SEXP check) { /* Check for non-leading NA values, throw error if found */ SEXP first; int _first; _first = firstNonNA(x); PROTECT(first = allocVector(INTSXP, 1)); INTEGER(first)[0] = _first; if(LOGICAL(check)[0]) { /* check for NAs in rest of data */ int i, nr; int *int_x = NULL; double *real_x = NULL; nr = nrows(x); switch(TYPEOF(x)) { case LGLSXP: int_x = LOGICAL(x); for(i=_first; i (int)maxgap) { /* check that we don't have excessive trailing gap */ for(ii = i-1; ii > i-gap-1; ii--) { int_result[ii] = NA_LOGICAL; } } } } else { /* nr-2 is first position to fill fromLast=TRUE */ for(j=0; j < nc; j++) { int_result[nr-1+j*nr] = int_x[nr-1+j*nr]; gap = 0; for(i=nr-2 + j*nr; i>=0+j*nr; i--) { int_result[i] = int_x[i]; if(int_result[i] == NA_LOGICAL && gap < maxgap) { int_result[i] = int_result[i+1]; gap++; } } } } break; case INTSXP: int_x = INTEGER(x); int_result = INTEGER(result); if(!LOGICAL(fromLast)[0]) { for(j=0; j < nc; j++) { /* copy leading NAs */ _first = firstNonNACol(x, j); if (_first == nr + j*nr) _first--; for(i=0+j*nr; i < (_first+1); i++) { int_result[i] = int_x[i]; } /* result[_first] now has first value fromLast=FALSE */ gap = 0; for(i=_first+1; i gap) int_result[i] = int_result[i-1]; gap++; } else { if((int)gap > (int)maxgap) { for(ii = i-1; ii > i-gap-1; ii--) { int_result[ii] = NA_INTEGER; } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have excessive trailing gap */ for(ii = i-1; ii > i-gap-1; ii--) { int_result[ii] = NA_INTEGER; } } } } else { /* nr-2 is first position to fill fromLast=TRUE */ for(j=0; j < nc; j++) { int_result[nr-1+j*nr] = int_x[nr-1+j*nr]; gap = 0; for(i=nr-2 + j*nr; i>=0+j*nr; i--) { int_result[i] = int_x[i]; if(int_result[i] == NA_INTEGER) { if(limit > gap) int_result[i] = int_result[i+1]; gap++; } else { if((int)gap > (int)maxgap) { for(ii = i+1; ii < i+gap+1; ii++) { int_result[ii] = NA_INTEGER; } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have leading trailing gap */ for(ii = i+1; ii < i+gap+1; ii++) { int_result[ii] = NA_INTEGER; } } } } break; case REALSXP: real_x = REAL(x); real_result = REAL(result); if(!LOGICAL(fromLast)[0]) { /* fromLast=FALSE */ for(j=0; j < nc; j++) { /* copy leading NAs */ _first = firstNonNACol(x, j); if (_first == nr + j*nr) _first--; for(i=0+j*nr; i < (_first+1); i++) { real_result[i] = real_x[i]; } /* result[_first] now has first value fromLast=FALSE */ gap = 0; for(i=_first+1; i gap) real_result[i] = real_result[i-1]; gap++; } else { if((int)gap > (int)maxgap) { for(ii = i-1; ii > i-gap-1; ii--) { real_result[ii] = NA_REAL; } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have excessive trailing gap */ for(ii = i-1; ii > i-gap-1; ii--) { real_result[ii] = NA_REAL; } } } } else { /* fromLast=TRUE */ for(j=0; j < nc; j++) { real_result[nr-1+j*nr] = real_x[nr-1+j*nr]; gap = 0; for(i=nr-2 + j*nr; i>=0+j*nr; i--) { real_result[i] = real_x[i]; if(ISNA(real_result[i]) || ISNAN(real_result[i])) { if(limit > gap) real_result[i] = real_result[i+1]; gap++; } else { if((int)gap > (int)maxgap) { for(ii = i+1; ii < i+gap+1; ii++) { real_result[ii] = NA_REAL; } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have leading trailing gap */ for(ii = i+1; ii < i+gap+1; ii++) { real_result[ii] = NA_REAL; } } } } break; case STRSXP: if(!LOGICAL(fromLast)[0]) { /* fromLast=FALSE */ for(j=0; j < nc; j++) { /* copy leading NAs */ _first = firstNonNACol(x, j); if (_first == nr + j*nr) _first--; for(i=0+j*nr; i < (_first+1); i++) { SET_STRING_ELT(result, i, STRING_ELT(x, i)); } /* result[_first] now has first value fromLast=FALSE */ gap = 0; for(i=_first+1; i gap) SET_STRING_ELT(result, i, STRING_ELT(result, i-1)); gap++; } else { if((int)gap > (int)maxgap) { for(ii = i-1; ii > i-gap-1; ii--) { SET_STRING_ELT(result, ii, NA_STRING); } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have excessive trailing gap */ for(ii = i-1; ii > i-gap-1; ii--) { SET_STRING_ELT(result, ii, NA_STRING); } } } } else { /* fromLast=TRUE */ for(j=0; j < nc; j++) { SET_STRING_ELT(result, nr-1+j*nr, STRING_ELT(x, nr-1+j*nr)); gap = 0; for(i=nr-2 + j*nr; i>=0+j*nr; i--) { SET_STRING_ELT(result, i, STRING_ELT(x, i)); if(STRING_ELT(result, i) == NA_STRING) { if(limit > gap) SET_STRING_ELT(result, i, STRING_ELT(result, i+1)); gap++; } else { if((int)gap > (int)maxgap) { for(ii = i+1; ii < i+gap+1; ii++) { SET_STRING_ELT(result, ii, NA_STRING); } } gap=0; } } if((int)gap > (int)maxgap) { /* check that we don't have leading trailing gap */ for(ii = i+1; ii < i+gap+1; ii++) { SET_STRING_ELT(result, ii, NA_STRING); } } } } break; default: error("unsupported type"); break; } if(Rf_asInteger(isXts(x))) { setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol)); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol)); copy_xtsCoreAttributes(x, result); copy_xtsAttributes(x, result); } UNPROTECT(P); return(result); } SEXP na_omit_xts (SEXP x) { SEXP na_index, not_na_index, col_index, result; int i, j, ij, nr, nc; int not_NA, NA; nr = nrows(x); nc = ncols(x); not_NA = nr; int *int_x=NULL, *int_na_index=NULL, *int_not_na_index=NULL; double *real_x=NULL; switch(TYPEOF(x)) { case LGLSXP: for(i=0; i. */ #include #include #include SEXP add_class (SEXP x, SEXP class) { if(MAYBE_SHARED(x)) x = duplicate(x); setAttrib(x, R_ClassSymbol, class); return(x); } xts/src/binsearch.c0000644000176200001440000001352514522244666014002 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include /* Binary search range to find interval written by Corwin Joy, with * contributions by Joshua Ulrich */ struct keyvec { double *dvec; double dkey; int *ivec; int ikey; }; /* Predicate function definition and functions to determine which of the * two groups contains the value being searched for. Note that they're all * 'static inline' to hopefully help with the compiler optimizations. */ typedef int (*bound_comparer)(const struct keyvec, const int); static inline int cmp_dbl_upper(const struct keyvec kv, const int i) { const double cv = kv.dvec[i]; const double ck = kv.dkey; return cv > ck; } static inline int cmp_dbl_lower(const struct keyvec kv, const int i) { const double cv = kv.dvec[i]; const double ck = kv.dkey; return cv >= ck; } static inline int cmp_int_upper(const struct keyvec kv, const int i) { const int cv = kv.ivec[i]; const int ck = kv.ikey; return cv > ck; } static inline int cmp_int_lower(const struct keyvec kv, const int i) { const int cv = kv.ivec[i]; const int ck = kv.ikey; return cv >= ck; } /* Binary search function */ SEXP binsearch(SEXP key, SEXP vec, SEXP start) { if (!isLogical(start)) { error("start must be specified as true or false"); } if (length(vec) < 1 || length(key) < 1) { return ScalarInteger(NA_INTEGER); } int use_start = LOGICAL(start)[0]; bound_comparer cmp_func = NULL; struct keyvec data; switch (TYPEOF(vec)) { case REALSXP: data.dkey = REAL(key)[0]; data.dvec = REAL(vec); cmp_func = (use_start) ? cmp_dbl_lower : cmp_dbl_upper; if (!R_finite(data.dkey)) { return ScalarInteger(NA_INTEGER); } break; case INTSXP: data.ikey = INTEGER(key)[0]; data.ivec = INTEGER(vec); cmp_func = (use_start) ? cmp_int_lower : cmp_int_upper; if (NA_INTEGER == data.ikey) { return ScalarInteger(NA_INTEGER); } break; default: error("unsupported type"); } int mid; int lo = 0; int hi = length(vec) - 1; while (lo < hi) { mid = lo + (hi - lo) / 2; if (cmp_func(data, mid)) { hi = mid; } else { lo = mid + 1; } } /* 'lo' contains the smallest index where cmp_func() is true, but we need * to handle edge cases where 'lo' is at the max/min end of the vector. */ if (use_start) { /* cmp_func() := vector[index] >= key when start == true, and we need * to return the smallest index subject to vector[index] >= key. */ if (!cmp_func(data, length(vec)-1)) { /* entire vector < key */ return ScalarInteger(NA_INTEGER); } } else { /* cmp_func() := vector[index] > key when start == false, and we need * to return the largest index subject to vector[index] <= key. */ if (cmp_func(data, lo)) { /* previous index value must satisfy vector[index] <= key, unless * current index value is zero. */ lo--; if (lo < 0) { /* entire vector > key */ return ScalarInteger(NA_INTEGER); } } } /* Convert from 0-based index to 1-based index */ lo++; return ScalarInteger(lo); } SEXP fill_window_dups_rev(SEXP _x, SEXP _index) { /* Translate user index (_x) to xts index (_index). '_x' contains the * upper bound of the location of the user index in the xts index. * This is necessary to handle duplicate dates in the xts index. */ int n_x = length(_x); int *x = INTEGER(_x); if (length(_index) < 1) { return allocVector(INTSXP, 0); } PROTECT_INDEX px; SEXP _out; PROTECT_WITH_INDEX(_out = allocVector(INTSXP, length(_index)), &px); int *out = INTEGER(_out); int i, xi, j, k = 0, n_out = length(_out); switch (TYPEOF(_index)) { case REALSXP: { double *index = REAL(_index); /* Loop over locations in _x in reverse order */ for (i = n_x; i > 0; i--) { xi = x[i-1]; j = xi; do { /* Check if we need to lengthen output due to duplicates */ if (k == n_out) { REPROTECT(_out = xlengthgets(_out, k+2*(i+1)), px); out = INTEGER(_out); n_out = length(_out); } out[k++] = j--; } while (j > 0 && index[xi-1] == index[j-1]); } } break; case INTSXP: { int *index = INTEGER(_index); /* Loop over locations in _x in reverse order */ for (i = n_x; i > 0; i--) { xi = x[i-1]; j = xi; do { /* Check if we need to lengthen output due to duplicates */ if (k == n_out) { REPROTECT(_out = xlengthgets(_out, k+2*(i+1)), px); out = INTEGER(_out); n_out = length(_out); } out[k++] = j--; } while (j > 0 && index[xi-1] == index[j-1]); } } break; default: error("unsupported index type"); } /* truncate so length(_out) = k * NB: output is in reverse order! */ REPROTECT(_out = xlengthgets(_out, k), px); UNPROTECT(1); return _out; } xts/src/rbind.c0000644000176200001440000004516414522244666013146 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include "xts.h" SEXP rbind_append(SEXP, SEXP); //SEXP do_rbind_xts (SEXP x, SEXP y, SEXP env) {{{ SEXP do_rbind_xts (SEXP x, SEXP y, SEXP dup) { int nrx, ncx, nry, ncy, truelen, len; int no_duplicate = LOGICAL(dup)[0]; int i, j, ij, ij_x, ij_y, xp=1, yp=1, add_y=0; int P=0; // PROTECT counter int mode; SEXP result, xindex, yindex, newindex; int *int_result=NULL, *int_x=NULL, *int_y=NULL; int *int_newindex=NULL, *int_xindex=NULL, *int_yindex=NULL; double *real_result=NULL, *real_x=NULL, *real_y=NULL; double *real_newindex=NULL, *real_xindex=NULL, *real_yindex=NULL; nrx = nrows(x); ncx = ncols(x); nry = nrows(y); ncy = ncols(y); truelen = len = nrx + nry; if( isNull(x) || isNull(y) ) { /* Handle NULL values by returning non-null object */ if(!isNull(x)) return x; return y; } if( !Rf_asInteger(isXts(x)) ) { PROTECT( x = tryXts(x) ); P++; } if( !Rf_asInteger(isXts(y)) ) { PROTECT( y = tryXts(y) ); P++; } /* need to convert different types of x and y if needed */ if( TYPEOF(x) != TYPEOF(y) ) { warning("mismatched types: converting objects to numeric"); // FIXME not working!!!???? PROTECT(x = coerceVector(x, REALSXP)); P++; PROTECT(y = coerceVector(y, REALSXP)); P++; } mode = TYPEOF(x); if(ncx != ncy) error("data must have same number of columns to bind by row"); PROTECT(xindex = getAttrib(x, xts_IndexSymbol)); P++; PROTECT(yindex = getAttrib(y, xts_IndexSymbol)); P++; if( TYPEOF(xindex) != TYPEOF(yindex) ) { PROTECT(xindex = coerceVector(xindex, REALSXP)); P++; PROTECT(yindex = coerceVector(yindex, REALSXP)); P++; } #ifdef RBIND_APPEND if(TYPEOF(xindex)==REALSXP) { if(REAL(xindex)[length(xindex)-1] < REAL(yindex)[0]) { UNPROTECT(P); return rbind_append(x,y); } } else if(TYPEOF(xindex)==INTSXP) { if(INTEGER(xindex)[length(xindex)-1] < INTEGER(yindex)[0]) { UNPROTECT(P); return rbind_append(x,y); } } #endif if(nrx != length(xindex) || nry != length(yindex)) error("zero-length vectors with non-zero-length index are not allowed"); PROTECT(newindex = allocVector(TYPEOF(xindex), len)); P++; PROTECT(result = allocVector(TYPEOF(x), len * ncx)); P++; switch( TYPEOF(x) ) { case INTSXP: int_x = INTEGER(x); int_y = INTEGER(y); int_result = INTEGER(result); break; case REALSXP: real_x = REAL(x); real_y = REAL(y); real_result = REAL(result); break; default: break; } /* if( TYPEOF(xindex) == REALSXP ) { if(REAL(xindex)[nrx-1] < REAL(yindex)[0]) { memcpy(REAL(newindex), REAL(xindex), sizeof(double) * nrx); memcpy(REAL(newindex)+nrx, REAL(yindex), sizeof(double) * nry); switch(TYPEOF(x)) { case INTSXP: memcpy(INTEGER(result), INTEGER(x), sizeof(int) * (nrx*ncx)); memcpy(INTEGER(result)+(nrx*ncx), INTEGER(y), sizeof(int) * (nry*ncy)); break; case REALSXP: memcpy(REAL(result), REAL(x), sizeof(double) * (nrx*ncx)); memcpy(REAL(result)+(nrx*ncx), REAL(y), sizeof(double) * (nry*ncy)); break; default: break; } UNPROTECT(P); return(result); } } else { } */ /* The main body of code to follow branches based on the type of index, removing the need to test at each position. */ if( TYPEOF(xindex) == REALSXP ) { real_newindex = REAL(newindex); real_xindex = REAL(xindex); real_yindex = REAL(yindex); for( i = 0; i < len; i++ ) { if( i >= truelen ) { break; } else if( xp > nrx ) { real_newindex[ i ] = real_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(y, ij_y)); break; default: break; } } yp++; } else if( yp > nry ) { real_newindex[ i ] = real_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); break; default: break; } } xp++; } else if( real_xindex[ xp-1 ] == real_yindex[ yp-1 ] ) { if( xp < nrx && real_xindex[ xp-1 ] < real_xindex[ xp ] ) add_y = 1; /* add y values only if next xindex is new */ if(no_duplicate) { add_y = 0; truelen--; } real_newindex[ i ] = real_xindex[ xp-1 ]; if(add_y) real_newindex[ i+ 1 ] = real_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; if(add_y) LOGICAL(result)[ ij+1 ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; if(add_y) int_result[ ij+1 ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; if(add_y) real_result[ ij+1 ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; if(add_y) COMPLEX(result)[ ij+1 ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); if(add_y) SET_STRING_ELT(result, ij+1, STRING_ELT(y, ij_y)); break; default: break; } } xp++; if(no_duplicate || add_y) { yp++; if(!no_duplicate) i++; // need to increase i as we now have filled in 2 values add_y = 0; } } else if( real_xindex[ xp-1 ] < real_yindex[ yp-1 ] ) { real_newindex[ i ] = real_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); break; default: break; } } xp++; } else if( real_xindex[ xp-1 ] > real_yindex[ yp-1 ] ) { real_newindex[ i ] = real_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(y, ij_y)); break; default: break; } } yp++; } } } else if( TYPEOF(xindex) == INTSXP ) { int_newindex = INTEGER(newindex); int_xindex = INTEGER(xindex); int_yindex = INTEGER(yindex); for(i = 0; i < len; i++) { /*Rprintf("xp:%i, yp:%i, i:%i\n",xp,yp,i);*/ if( i >= truelen ) { break; } else if( xp > nrx ) { int_newindex[ i ] = int_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(y, ij_y)); break; default: break; } } yp++; } else if( yp > nry ) { int_newindex[ i ] = int_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); break; default: break; } } xp++; } else if( int_xindex[ xp-1 ] == int_yindex[ yp-1 ] ) { if( xp < nrx && int_xindex[ xp-1 ] < int_xindex[ xp ] ) add_y = 1; if(no_duplicate) { add_y = 0; truelen--; } int_newindex[ i ] = int_xindex[ xp-1 ]; if(add_y) int_newindex[ i+1 ] = int_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; if(add_y) LOGICAL(result)[ ij+1 ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; if(add_y) int_result[ ij+1 ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; if(add_y) real_result[ ij+1 ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; if(add_y) COMPLEX(result)[ ij+1 ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); if(add_y) SET_STRING_ELT(result, ij+1, STRING_ELT(y, ij_y)); break; default: break; } } xp++; if(no_duplicate || add_y) { yp++; if(!no_duplicate) i++; // need to increase i as we now have filled in 2 values add_y = 0; } } else if( int_xindex[ xp-1 ] < int_yindex[ yp-1 ] ) { int_newindex[ i ] = int_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_x = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(x)[ ij_x ]; break; case INTSXP: int_result[ ij ] = int_x[ ij_x ]; break; case REALSXP: real_result[ ij ] = real_x[ ij_x ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(x)[ ij_x ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(x, ij_x)); break; default: break; } } xp++; } else if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) { int_newindex[ i ] = int_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { ij = i + j * len; ij_y = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij ] = LOGICAL(y)[ ij_y ]; break; case INTSXP: int_result[ ij ] = int_y[ ij_y ]; break; case REALSXP: real_result[ ij ] = real_y[ ij_y ]; break; case CPLXSXP: COMPLEX(result)[ ij ] = COMPLEX(y)[ ij_y ]; break; case STRSXP: SET_STRING_ELT(result, ij, STRING_ELT(y, ij_y)); break; default: break; } } yp++; }} } if(truelen != len) { PROTECT(result = lengthgets(result, truelen * ncx)); P++; /* reset length */ } setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); SEXP dim; PROTECT(dim = allocVector(INTSXP, 2)); INTEGER(dim)[0] = truelen; INTEGER(dim)[1] = ncx; UNPROTECT(1); setAttrib(result, R_DimSymbol, dim); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); if(truelen != len) { PROTECT(newindex = lengthgets(newindex, truelen)); P++; } copyMostAttrib(xindex, newindex); setAttrib(result, xts_IndexSymbol, newindex); setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); copy_xtsAttributes(x, result); UNPROTECT(P); return result; } //}}} // SEXP rbindXts ( .External("rbindXts", ...) ) {{{ SEXP rbindXts (SEXP args) { SEXP _x; SEXP dup; int P=0; PROTECT_INDEX ipx; args = CDR(args); // 'rbindXts' call name PROTECT(dup = CAR(args)); P++; args = CDR(args); PROTECT(_x = CAR(args)); P++; args = CDR(args); if(args == R_NilValue) { UNPROTECT(P); return(_x); } PROTECT_WITH_INDEX(_x = do_rbind_xts(_x, CAR(args), dup), &ipx); P++; args = CDR(args); while(args != R_NilValue) { REPROTECT(_x = do_rbind_xts(_x, CAR(args), dup), ipx); args = CDR(args); } if(P > 0) UNPROTECT(P); return _x; } //}}} SEXP rbind_append (SEXP x, SEXP y) { /* Provide fast row binding of xts objects if the left-hand object (binding target) has a last index value less than the right-hand object (object to bind). This is an optimization to allow for real-time updating of objects without having to do much more than a memcpy of the two in coordinated fashion */ /*Rprintf("rbind_append called\n");*/ SEXP result; int nrs_x, nrs_y, ncs_x, ncs_y, nr; int i; ncs_x = ncols(x); ncs_y = ncols(y); nrs_x = nrows(x); nrs_y = nrows(y); if(ncs_x != ncs_y) error("objects must have the same number of columns"); /* FIXME */ PROTECT(result = allocVector(TYPEOF(x), (nrs_x + nrs_y) * ncs_x)); nr = nrs_x + nrs_y; switch(TYPEOF(x)) { case REALSXP: for(i=0; i< ncs_x; i++) { memcpy(&(REAL(result)[i*nr]), &(REAL(x)[i*nrs_x]), nrs_x*sizeof(double)); memcpy(&(REAL(result)[i*nr + nrs_x]), &(REAL(y)[i*nrs_y]), nrs_y*sizeof(double)); } break; case INTSXP: for(i=0; i< ncs_x; i++) { memcpy(&(INTEGER(result)[i*nr]), &(INTEGER(x)[i*nrs_x]), nrs_x*sizeof(int)); memcpy(&(INTEGER(result)[i*nr + nrs_x]), &(INTEGER(y)[i*nrs_y]), nrs_y*sizeof(int)); } break; case LGLSXP: for(i=0; i< ncs_x; i++) { memcpy(&(LOGICAL(result)[i*nr]), &(LOGICAL(x)[i*nrs_x]), nrs_x*sizeof(int)); memcpy(&(LOGICAL(result)[i*nr + nrs_x]), &(LOGICAL(y)[i*nrs_y]), nrs_y*sizeof(int)); } break; case CPLXSXP: for(i=0; i< ncs_x; i++) { memcpy(&(COMPLEX(result)[i*nr]), &(COMPLEX(x)[i*nrs_x]), nrs_x*sizeof(Rcomplex)); memcpy(&(COMPLEX(result)[i*nr + nrs_x]), &(COMPLEX(y)[i*nrs_y]), nrs_y*sizeof(Rcomplex)); } break; case RAWSXP: for(i=0; i< ncs_x; i++) { memcpy(&(RAW(result)[i*nr]), &(RAW(x)[i*nrs_x]), nrs_x*sizeof(Rbyte)); memcpy(&(RAW(result)[i*nr + nrs_x]), &(RAW(y)[i*nrs_y]), nrs_y*sizeof(Rbyte)); } break; case STRSXP: /* this requires an explicit loop like rbind.c and needs to be left with rbind.c */ break; default: error("unsupported type"); } copyAttributes(x, result); SEXP index, xindex, yindex; xindex = getAttrib(x, xts_IndexSymbol); yindex = getAttrib(y, xts_IndexSymbol); int INDEXTYPE = TYPEOF(xindex); if(INDEXTYPE != NILSXP) { PROTECT(index = allocVector(INDEXTYPE, nr)); if(INDEXTYPE==REALSXP) { memcpy(REAL(index), REAL(xindex), nrs_x * sizeof(double)); memcpy(&(REAL(index)[nrs_x]), REAL(yindex), nrs_y * sizeof(double)); } else if(INDEXTYPE==INTSXP) { memcpy(INTEGER(index), INTEGER(xindex), nrs_x * sizeof(int)); memcpy(&(INTEGER(index)[nrs_x]), INTEGER(yindex), nrs_y * sizeof(int)); } copyMostAttrib(xindex, index); setAttrib(result, xts_IndexSymbol, index); UNPROTECT(1); } SEXP dim; PROTECT(dim = allocVector(INTSXP, 2)); INTEGER(dim)[0] = nr; INTEGER(dim)[1] = ncs_x; /* should be the same */ setAttrib(result, R_DimSymbol, dim); UNPROTECT(1); setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol)); /* SEXP dimnames, currentnames, newnames; PROTECT(dimnames = allocVector(VECSXP, 2)); PROTECT(newnames = allocVector(STRSXP, length(j))); currentnames = getAttrib(x, R_DimNamesSymbol); if(!isNull(currentnames)) { SET_VECTOR_ELT(dimnames, 0, R_NilValue); for(i=0; i. */ #include #include #include "xts.h" SEXP coredata (SEXP x, SEXP copyAttr) { /* copyAttr is a LGLSXP flag to indicate whether all attributes are to be left intact. This provides compatability with xts, by stripping all attributes if desired, without the overhead or adding then removing */ SEXP result; int i, j, ncs, nrs; int P=0; PROTECT(result = allocVector(TYPEOF(x), length(x))); P++; switch( TYPEOF(x)) { case REALSXP: memcpy(REAL(result), REAL(x), length(result) * sizeof(double)); break; case INTSXP: memcpy(INTEGER(result), INTEGER(x), length(result) * sizeof(int)); break; case LGLSXP: memcpy(LOGICAL(result), LOGICAL(x), length(result) * sizeof(int)); break; case CPLXSXP: memcpy(COMPLEX(result), COMPLEX(x), length(result) * sizeof(Rcomplex)); break; case STRSXP: ncs = ncols(x); nrs = nrows(x); for(j=0; j< ncs; j++) for(i=0; i< nrs; i++) SET_STRING_ELT(result, i+j*nrs, STRING_ELT(x, i+j*nrs)); break; case RAWSXP: memcpy(RAW(result), RAW(x), length(result) * sizeof(unsigned char)); break; default: error("currently unsupported data type"); break; } if( !isNull(getAttrib(x, R_DimSymbol))) { setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol)); if( !isNull(getAttrib(x, R_DimNamesSymbol)) ) { setAttrib(result, R_DimNamesSymbol, getAttrib(x,R_DimNamesSymbol)); } } else { setAttrib(result, R_NamesSymbol, getAttrib(x, R_NamesSymbol)); } if( asLogical(copyAttr)) { copyMostAttrib(x,result); setAttrib(result, R_ClassSymbol, getAttrib(x, install("oclass"))); } setAttrib(result, xts_IndexSymbol, R_NilValue); setAttrib(result, install("oclass"), R_NilValue); setAttrib(result, install("frequency"), R_NilValue); UNPROTECT(P); return result; } SEXP coredata_xts(SEXP x) { return zoo_coredata(x, ScalarLogical(0)); } xts/src/startofyear.c0000644000176200001440000000465714522244666014415 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include SEXP do_startofyear (SEXP _from, SEXP _to, SEXP _origin) { // do_startofyear {{{ int i, P = 0; int from = INTEGER(_from)[0]; int to = INTEGER(_to)[0]; int origin = INTEGER(_origin)[0]; // _fromto is a vector of length (from:to) SEXP _fromto = PROTECT(allocVector(INTSXP, to-from+1)); P++; int *fromto = INTEGER(_fromto); int nyear[1] = { (to - from + 1) }; int leap[nyear[0]]; // generate sequence of dates to work with fromto[0] = from; for(i=1; i < nyear[0]; i++) { fromto[i] = fromto[i-1] + 1; } for(i = 0; i < nyear[0]; i++) { leap[ i ] = ( (fromto[ i ] % 4 == 0 && fromto[ i ] % 100 != 0) || fromto[ i ] % 400 == 0) ? 1 : 0; } for(i=0; i < nyear[0]; i++) { if(leap[i] == 1) { // a leapyear (366 days) fromto[i] = 366; } else { // a non-leapyear (365 days) fromto[i] = 365; } } /* fromto now has proper number of days per year now calculate the cumulative sum back from origin (negative) and from origin (positive) */ int days_before_origin = origin - from; //int days_after_origin = nyear[0] - days_before_origin - 1; //why is this here? int tmp=0; for(i = days_before_origin; i < nyear[0]; i++) { tmp += fromto[i]; fromto[i] = tmp; } tmp = 0; for(i = days_before_origin-1; i >= 0; i--) { tmp -= fromto[i]; fromto[i] = tmp; } /* now insert a 0 at the origin, by going backwards */ for(i = nyear[0] - 1; i > days_before_origin; i--) fromto[ i ] = fromto[ i-1 ]; fromto[ days_before_origin ] = 0; UNPROTECT(P); return _fromto; } //}}} xts/src/tryXts.c0000644000176200001440000000275514522244666013364 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include "xts.h" SEXP tryXts (SEXP x) { if( !Rf_asInteger(isXts(x)) ) { int P = 0; SEXP s, t, result, env, str_xts; PROTECT(s = t = allocList(2)); P++; SET_TYPEOF(s, LANGSXP); SETCAR(t, install("try.xts")); t = CDR(t); SETCAR(t, x); t=CDR(t); PROTECT(str_xts = mkString("xts")); P++; PROTECT(env = R_FindNamespace(str_xts)); P++; PROTECT(result = eval(s, env)); P++; if( !Rf_asInteger(isXts(result)) ) { UNPROTECT(P); error("rbind.xts requires xtsible data"); } UNPROTECT(P); return result; } return x; } /* SEXP try_xts (SEXP x) { SEXP y; PROTECT(y = tryXts(x)); UNPROTECT(1); return y; } */ xts/src/endpoints.c0000644000176200001440000001031714522244666014043 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include SEXP endpoints (SEXP _x, SEXP _on, SEXP _k, SEXP _addlast /* TRUE */) { /* efficient implementation of: c(0,which(diff(_x%/%on%/%k+1) != 0),NROW(_x)) */ int *int_index = NULL; double *real_index = NULL; int i=1,j=1, nr, P=0; int int_tmp[2]; int64_t int64_tmp[2]; /* shouldn't force to INTSXP, as this now excludes microsecond and millisecond calculations FIXME */ int on = INTEGER(coerceVector(_on,INTSXP))[0]; int k = INTEGER(coerceVector(_k,INTSXP))[0]; nr = nrows(_x); /* ensure k > 0 (bug #4920) */ if(k <= 0) error("'k' must be > 0"); /* endpoints objects. max nr+2 ( c(0,ep,nr) ) */ SEXP _ep = PROTECT(allocVector(INTSXP,nr+2)); P++; int *ep = INTEGER(_ep); /*switch(TYPEOF(getAttrib(_x, install("index")))) {*/ switch(TYPEOF(_x)) { case INTSXP: /* start i at second elem */ /*int_index = INTEGER(getAttrib(_x, install("index")));*/ int_index = INTEGER(_x); ep[0] = 0; /* special handling if index values < 1970-01-01 00:00:00 UTC */ if(int_index[0] < 0) { int_tmp[1] = (int_index[0] + 1) / on / k; for(i=1,j=1; i. */ #include #include SEXP any_negative (SEXP i_) { int i; int len = length(i_); int *int_i=NULL; double *real_i=NULL; if(TYPEOF(i_)==INTSXP) { int_i = INTEGER(i_); for(i=0; i= 0) continue; return ScalarLogical(1); } } else if(TYPEOF(i_)==REALSXP) { real_i = REAL(i_); for(i=0; i= 0) continue; return ScalarLogical(1); } } return ScalarLogical(0); } xts/src/totalcols.c0000644000176200001440000000304114522244666014040 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include #include "xts.h" int xts_ncols (SEXP _x) { int ncols_x = 0; // use dims if possible if (isNull(getAttrib(_x, R_DimSymbol))) { // no dims, so we want: // * ncols_x == 0 for zero-length vectors, and // * ncols_x == 1 for anything else that doesn't have dims ncols_x = LENGTH(_x) > 0; } else { // use dims ncols_x = INTEGER(getAttrib(_x, R_DimSymbol))[1]; } return ncols_x; } SEXP number_of_cols (SEXP args) { int i = 0; args = CDR(args); // calling function name SEXP tcols = PROTECT(allocVector(INTSXP, length(args))); for(;args != R_NilValue; i++, args = CDR(args)) { INTEGER(tcols)[i] = xts_ncols(CAR(args)); } UNPROTECT(1); return tcols; } xts/src/period_apply.c0000644000176200001440000000477314522244666014540 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan (FORTRAN implementation) # Copyright (C) 2018 Joshua M. Ulrich (C implementation) # # 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, see . */ #include #include "xts.h" SEXP xts_period_apply(SEXP _data, SEXP _index, SEXP _function, SEXP _env) { int i; R_xlen_t n = xlength(_index); SEXP _result = PROTECT(allocVector(VECSXP, n)); SEXP _j = PROTECT(allocVector(INTSXP, ncols(_data))); SEXP _drop = PROTECT(ScalarLogical(0)); for (i = 0; i < ncols(_data); i++) INTEGER(_j)[i] = i + 1; SEXP _idx0 = PROTECT(ScalarInteger(0)); SEXP _idx1 = PROTECT(ScalarInteger(0)); int *idx0 = INTEGER(_idx0); int *idx1 = INTEGER(_idx1); /* reprotect the subset object */ SEXP _xsubset; PROTECT_INDEX px; PROTECT_WITH_INDEX(_xsubset = R_NilValue, &px); /* subset object name */ SEXP _subsym = install("_.*crazy*._.*name*._"); defineVar(_subsym, _xsubset, _env); /* function call on subset */ SEXP _subcall = PROTECT(lang3(_function, _subsym, R_DotsSymbol)); int N = n - 1; switch(TYPEOF(_index)) { case REALSXP: ; double *d_index = REAL(_index); for (i = 0; i < N; i++) { idx0[0] = d_index[i] + 1; idx1[0] = d_index[i + 1]; REPROTECT(_xsubset = extract_col(_data, _j, _drop, _idx0, _idx1), px); defineVar(_subsym, _xsubset, _env); SET_VECTOR_ELT(_result, i, eval(_subcall, _env)); } break; case INTSXP: ; int *i_index = INTEGER(_index); for (i = 0; i < N; i++) { idx0[0] = i_index[i] + 1; idx1[0] = i_index[i + 1]; REPROTECT(_xsubset = extract_col(_data, _j, _drop, _idx0, _idx1), px); defineVar(_subsym, _xsubset, _env); SET_VECTOR_ELT(_result, i, eval(_subcall, _env)); } break; default: error("unsupported index type"); } UNPROTECT(7); return _result; } xts/src/extract_col.c0000644000176200001440000001342214522244666014347 0ustar liggesusers/* # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . */ #include #include #include "xts.h" /* provide fast memcpy extraction by column major orientation for matrix objects. Should be as fast as extracting list elements or data.frame columns in R. ( update: it is much faster actually -jar ) One key difference is that we are also reattaching the index attribute to allow for the object to remain a zoo/xts object */ SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_) { SEXP result, index, new_index; int nrs, nrsx, i, ii, jj, first, last; nrsx = nrows(x); first = asInteger(first_)-1; last = asInteger(last_)-1; /* nrs = offset_end - offset_start - 1; */ nrs = last - first + 1; PROTECT(result = allocVector(TYPEOF(x), nrs * length(j))); switch(TYPEOF(x)) { case REALSXP: for(i=0; i. */ #include #include #include #include "xts.h" SEXP xts_merge_make_colnames (SEXP colnames, SEXP suffixes, SEXP check_names, SEXP env) { int p = 0; SEXP newcolnames = colnames; // add suffixes if(R_NilValue != suffixes) { SEXP s, t; PROTECT(s = t = allocList(4)); p++; SET_TYPEOF(s, LANGSXP); SETCAR(t, install("paste")); t = CDR(t); SETCAR(t, newcolnames); t = CDR(t); SETCAR(t, suffixes); t = CDR(t); SETCAR(t, mkString("")); SET_TAG(t, install("sep")); PROTECT(newcolnames = eval(s, env)); p++; } // check that names are 'valid R names' if (LOGICAL(check_names)[0]) { SEXP s, t, unique; PROTECT(s = t = allocList(3)); p++; SET_TYPEOF(s, LANGSXP); PROTECT(unique = ScalarLogical(1)); p++; SETCAR(t, install("make.names")); t = CDR(t); SETCAR(t, newcolnames); t = CDR(t); SETCAR(t, unique); SET_TAG(t, install("unique")); PROTECT(newcolnames = eval(s, env)); p++; } UNPROTECT(p); return(newcolnames); } SEXP xts_merge_combine_dimnames (SEXP _x, SEXP _y, int ncol_x, int ncol_y, SEXP _orig_colnames) { int p = 0; int ncols = ncol_x + ncol_y; SEXP colnames = PROTECT(allocVector(STRSXP, ncols)); p++; SEXP dimnames_x = PROTECT(getAttrib(_x, R_DimNamesSymbol)); p++; SEXP dimnames_y = PROTECT(getAttrib(_y, R_DimNamesSymbol)); p++; // do 'x' and/or 'y' have column names? SEXP colnames_x = R_NilValue; SEXP colnames_y = R_NilValue; if (!isNull(dimnames_x) && !isNull(VECTOR_ELT(dimnames_x, 1))) { colnames_x = VECTOR_ELT(dimnames_x, 1); } if (!isNull(dimnames_y) && !isNull(VECTOR_ELT(dimnames_y, 1))) { colnames_y = VECTOR_ELT(dimnames_y, 1); } // time to combine the two for (int i = 0; i < ncols; i++) { if (i < ncol_x) { // copy column names from 'x' if (R_NilValue != colnames_x) { SET_STRING_ELT(colnames, i, STRING_ELT(colnames_x, i)); } else { SET_STRING_ELT(colnames, i, STRING_ELT(_orig_colnames, i)); } } else { // copy column names from 'y' if (R_NilValue != colnames_y) { SET_STRING_ELT(colnames, i, STRING_ELT(colnames_y, i - ncol_x)); } else { SET_STRING_ELT(colnames, i, STRING_ELT(_orig_colnames, i)); } } } UNPROTECT(p); return(colnames); } /* This is a merge_join algorithm used to allow two xts objects to be merged as one along a common index efficiently and fast The code is branched for REAL and INTEGER indexed values which allows for efficient memory usage and minimal testing/coercion Copyright Jeffrey A. Ryan 2008 */ /* do_merge_xts {{{ */ SEXP do_merge_xts (SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass, SEXP colnames, SEXP suffixes, SEXP retside, SEXP check_names, SEXP env, SEXP coerce) { int nrx, ncx, nry, ncy, len; int left_join, right_join; int i = 0, j = 0, xp = 1, yp = 1; /* x and y positions in index */ int mode; int ij_original, ij_result; int p = 0; SEXP xindex, yindex, index, result, attr, len_xindex; SEXP s, t; int *int_result=NULL, *int_x=NULL, *int_y=NULL, int_fill=0; int *int_index=NULL, *int_xindex=NULL, *int_yindex=NULL; double *real_result=NULL, *real_x=NULL, *real_y=NULL; double *real_index=NULL, *real_xindex=NULL, *real_yindex=NULL; /* we do not check that 'x' is an xts object. Dispatch and mergeXts (should) make this unecessary. So we just get the index value This assumption seems to be invalid when dispatched from cbind.xts So we need to check that the objects are not NULL, or at least treat NULL objects as zero-width with an index that matches the non-null 2009/01/07: calling merge(NA,x) or merge(1,1,xts) causes a segfault; calling merge(1,x) causes the xts-info (none!) from the 1st arg to be used, resulting in a classless object. [fixed - jar] */ if( isNull(x) || isNull(y) ) { if(!isNull(x)) return(x); return(y); } PROTECT( xindex = getAttrib(x, xts_IndexSymbol) ); p++; /* convert to xts object if needed */ if( !Rf_asInteger(isXts(y)) ) { PROTECT(s = t = allocList(4)); p++; SET_TYPEOF(s, LANGSXP); SETCAR(t, install("try.xts")); t = CDR(t); SETCAR(t, y); t = CDR(t); PROTECT( len_xindex = allocVector(INTSXP, 1)); p++; INTEGER(len_xindex)[0] = length(xindex); SETCAR(t, len_xindex); SET_TAG(t, install("length.out")); t = CDR(t); SETCAR(t, install(".merge.xts.scalar")); SET_TAG(t, install("error")); PROTECT(y = eval(s, env)); p++; } /* end conversion process */ mode = TYPEOF(x); if( Rf_asInteger(isXts(y)) ) { PROTECT( yindex = getAttrib(y, xts_IndexSymbol) ); p++; } else { PROTECT( yindex = getAttrib(x, xts_IndexSymbol) ); p++; } if( TYPEOF(retside) != LGLSXP ) error("retside must be a logical value of TRUE or FALSE"); /* determine number of rows and columns to use for the inputs */ int return_x_data = LOGICAL(retside)[0]; int is_xobs_zero = LENGTH(x) == 0; int is_xdim_null = isNull(getAttrib(x, R_DimSymbol)); nrx = nrows(x); ncx = ncols(x); if (return_x_data) { if (is_xdim_null) { if (is_xobs_zero) { nrx = LENGTH(xindex); ncx = 0; PROTECT(x = coerceVector(x, TYPEOF(y))); p++; } } else { if (is_xobs_zero) { nrx = LENGTH(xindex); ncx = INTEGER(getAttrib(x, R_DimSymbol))[1]; PROTECT(x = coerceVector(x, TYPEOF(y))); p++; } } } else { nrx = LENGTH(xindex); ncx = 0; PROTECT(x = coerceVector(x, TYPEOF(y))); p++; } int return_y_data = LOGICAL(retside)[1]; int is_yobs_zero = LENGTH(y) == 0; int is_ydim_null = isNull(getAttrib(y, R_DimSymbol)); nry = nrows(y); ncy = ncols(y); if (return_y_data) { if (is_ydim_null) { if (is_yobs_zero) { nry = LENGTH(yindex); ncy = 0; PROTECT(y = coerceVector(y, TYPEOF(x))); p++; } } else { if (is_yobs_zero) { nry = LENGTH(yindex); ncy = INTEGER(getAttrib(y, R_DimSymbol))[1]; PROTECT(y = coerceVector(y, TYPEOF(x))); p++; } } } else { nry = LENGTH(yindex); ncy = 0; PROTECT(y = coerceVector(y, TYPEOF(x))); p++; } /* do the inputs have any data to merge? */ len = nrx + nry; if (len < 1 && ncx < 1 && ncy < 1) { /* nothing to do, return empty xts object */ SEXP s, t; PROTECT(s = t = allocList(1)); p++; SET_TYPEOF(s, LANGSXP); SETCAR(t, install("xts")); SEXP out = PROTECT(eval(s, env)); p++; SET_TYPEOF(out, TYPEOF(x)); UNPROTECT(p); return out; } /* at present we are failing the call if the indexing is of mixed type. This should probably instead simply coerce to REAL so as not to lose any information (at the expense of conversion cost and memory), and issue a warning. */ if( TYPEOF(xindex) != TYPEOF(yindex) ) { PROTECT(xindex = coerceVector(xindex, REALSXP)); p++; PROTECT(yindex = coerceVector(yindex, REALSXP)); p++; } if( TYPEOF(all) != LGLSXP ) error("all must be a logical value of TRUE or FALSE"); left_join = INTEGER(all)[ 0 ]; right_join = INTEGER(all)[ 1 ]; /* determine num_rows of final merged xts object this seems to only cost 1/1000 of a sec per 1e6 observations. Acceptable 'waste' given that now we can properly allocate space for our results We also check the index type and use the appropriate macros */ if( TYPEOF(xindex) == REALSXP ) { real_xindex = REAL(xindex); real_yindex = REAL(yindex); /* Check for illegal values before looping. Due to ordered index, * -Inf must be first, while NA, Inf, and NaN must be last. */ if (!R_FINITE(real_xindex[0]) || !R_FINITE(real_xindex[nrx-1]) || !R_FINITE(real_yindex[0]) || !R_FINITE(real_yindex[nry-1])) { error("'index' cannot contain 'NA', 'NaN', or '+/-Inf'"); } while( (xp + yp) <= (len + 1) ) { if( xp > nrx ) { yp++; if(right_join) i++; } else if( yp > nry ) { xp++; if(left_join) i++; } else if( real_xindex[ xp-1 ] == real_yindex[ yp-1 ] ) { /* INNER JOIN --- only result if all=FALSE */ yp++; xp++; i++; } else if( real_xindex[ xp-1 ] < real_yindex[ yp-1 ] ) { /* LEFT JOIN */ xp++; if(left_join) i++; } else if( real_xindex[ xp-1 ] > real_yindex[ yp-1 ] ) { /* RIGHT JOIN */ yp++; if(right_join) i++; } else error("Invalid index element comparison (should never happen)"); } } else if( TYPEOF(xindex) == INTSXP ) { int_xindex = INTEGER(xindex); int_yindex = INTEGER(yindex); /* Check for NA before looping; logical ops on NA may yield surprising * results. Note that the NA_integer_ will appear in the last value of * the index because of sorting at the R level, even though NA_INTEGER * equals INT_MIN at the C level. */ if (int_xindex[nrx-1] == NA_INTEGER || int_yindex[nry-1] == NA_INTEGER) { error("'index' cannot contain 'NA'"); } while( (xp + yp) <= (len + 1) ) { if( xp > nrx ) { yp++; if(right_join) i++; } else if( yp > nry ) { xp++; if(left_join) i++; } else if( int_xindex[ xp-1 ] == int_yindex[ yp-1 ] ) { yp++; xp++; i++; } else if( int_xindex[ xp-1 ] < int_yindex[ yp-1 ] ) { xp++; if(left_join) i++; } else if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) { yp++; if(right_join) i++; } else error("Invalid index element comparison (should never happen)"); } } if(i == 0) { /* return a zero-length xts object if no rows match, consistent w/zoo */ PROTECT( result = allocMatrix(TYPEOF(x), 0, ncx + ncy) ); p++; PROTECT( index = allocVector(TYPEOF(xindex), 0) ); p++; // set tclass, tzone, and tformat from x-index setAttrib(index, xts_IndexTzoneSymbol, getAttrib(xindex, xts_IndexTzoneSymbol)); setAttrib(index, xts_IndexTclassSymbol, getAttrib(xindex, xts_IndexTclassSymbol)); setAttrib(index, xts_IndexTformatSymbol, getAttrib(xindex, xts_IndexTformatSymbol)); SET_xtsIndex(result, index); /* dimnames */ if(!isNull(colnames)) { // only set DimNamesSymbol if passed colnames is not NULL SEXP newcolnames = PROTECT(xts_merge_combine_dimnames(x, y, ncx, ncy, colnames)); p++; newcolnames = PROTECT(xts_merge_make_colnames(newcolnames, suffixes, check_names, env)); p++; SEXP dimnames = PROTECT(allocVector(VECSXP, 2)); p++; SET_VECTOR_ELT(dimnames, 0, R_NilValue); SET_VECTOR_ELT(dimnames, 1, newcolnames); setAttrib(result, R_DimNamesSymbol, dimnames); } /* dimnames */ if(LOGICAL(retclass)[0]) setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); UNPROTECT(p); return result; } int num_rows = i; xp = 1; yp = 1; PROTECT( index = allocVector(TYPEOF(xindex), num_rows) ); p++; /* coercion/matching of TYPE for x and y needs to be checked, either here or in the calling R code. I suspect here is more useful if other function can call the C code as well. If objects are not the same type, convert to REALSXP. */ if( Rf_asInteger(coerce) || TYPEOF(x) != TYPEOF(y) ) { PROTECT( x = coerceVector(x, REALSXP) ); p++; PROTECT( y = coerceVector(y, REALSXP) ); p++; } PROTECT( result = allocVector(TYPEOF(x), (ncx + ncy) * num_rows) ); p++; /* Ensure fill is the correct length and type */ if( length(fill) < 1 ) { PROTECT( fill = ScalarLogical(NA_LOGICAL) ); p++; } if( TYPEOF(fill) != TYPEOF(x) ) { PROTECT( fill = coerceVector(fill, TYPEOF(x)) ); p++; } mode = TYPEOF(x); /* use pointers instead of function calls */ switch(TYPEOF(x)) { case INTSXP: int_x = INTEGER(x); int_y = INTEGER(y); int_fill = INTEGER(fill)[0]; int_result = INTEGER(result); break; case REALSXP: real_x = REAL(x); real_y = REAL(y); /*real_fill = REAL(fill)[0];*/ real_result = REAL(result); break; default: break; } switch(TYPEOF(xindex)) { case INTSXP: int_index = INTEGER(index); break; case REALSXP: real_index = REAL(index); break; default: break; } /* There are two type of supported index types, each branched from here */ if( TYPEOF(xindex) == REALSXP ) { /* REAL INDEXING */ for(i = 0; i < num_rows; i++) { /* If we are past the last row in x, assign NA to merged data and copy the y column values to the second side of result */ if( xp > nrx ) { if(right_join) { real_index[ i ] = real_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; break; case INTSXP: /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/ int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_y[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } } yp++; if(!right_join) i--; /* if all=FALSE, we must decrement i for each non-match */ } else /* past the last row of y */ if( yp > nry ) { if(left_join) { /* record new index value */ real_index[ i ] = real_xindex[ xp-1 ]; /* copy values from x and y to result */ for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_x[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } /* we are out of y-values, so fill merged result with NAs */ for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; break; case INTSXP: /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/ int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } } xp++; if(!left_join) i--; } else /* matching index values copy all column values from x and y to results */ if( real_xindex[ xp-1 ] == real_yindex[ yp-1 ] ) { real_index[ i ] = real_xindex[ xp-1 ]; /* copy x-values to result */ for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_x[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } /* copy y-values to result */ for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_y[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } xp++; yp++; } else if( real_xindex[ xp-1 ] < real_yindex[ yp-1 ] ) { if(left_join) { real_index[ i ] = real_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_x[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; break; case INTSXP: /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ]; */ int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } } xp++; if(!left_join) i--; } else if( real_xindex[ xp-1 ] > real_yindex[ yp-1 ] ) { if(right_join) { real_index[ i ] = real_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; break; case INTSXP: /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/ int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_y[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } } yp++; if(!right_join) i--; } } } else if( TYPEOF(xindex) == INTSXP ) { for(i = 0; i < num_rows; i++) { /* If we are past the last row in x, assign NA to merged data and copy the y column values to the second side of result */ if( xp > nrx ) { if(right_join) { int_index[ i ] = int_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { /* x-values */ ij_result = i + j * num_rows; switch( mode ) { case LGLSXP: case INTSXP: /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/ int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_y[ ij_original ]; break; case REALSXP: real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } } yp++; if(!right_join) i--; /* if all=FALSE, we must decrement i for each non-match */ } else /* past the last row of y */ if( yp > nry ) { if(left_join) { /* record new index value */ int_index[ i ] = int_xindex[ xp-1 ]; /* copy values from x and y to result */ for(j = 0; j < ncx; j++) { // x-values ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; //num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_x[ ij_original]; //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ]; break; case REALSXP: //REAL(result)[ ij_result ] = REAL(x)[ ij_original ]; real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } /* we are out of y-values, so fill merged result with NAs */ for(j = 0; j < ncy; j++) { // y-values ij_result = i + (j+ncx) * num_rows; //REAL(result)[ ij_result ] = NA_REAL; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; //NA_INTEGER; break; case INTSXP: int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; //NA_REAL; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); //NA_STRING); break; default: error("unsupported data type"); break; } } } xp++; if(!left_join) i--; } else /* matching index values copy all column values from x and y to results */ //if( INTEGER(xindex)[ xp-1 ] == INTEGER(yindex)[ yp-1 ] ) { if( int_xindex[ xp-1 ] == int_yindex[ yp-1 ] ) { /* copy index FIXME this needs to handle INTEGER efficiently as well*/ //INTEGER(index)[ i ] = INTEGER(xindex)[ xp-1 ]; int_index[ i ] = int_xindex[ xp-1 ]; /* copy x-values to result */ for(j = 0; j < ncx; j++) { // x-values ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; //num_rows; //REAL(result)[ ij_result ] = REAL(x)[ ij_original ]; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_x[ ij_original ]; //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ]; break; case REALSXP: //REAL(result)[ ij_result ] = REAL(x)[ ij_original ]; real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } /* copy y-values to result */ for(j = 0; j < ncy; j++) { // y-values ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; //num_rows; //REAL(result)[ ij_result ] = REAL(y)[ ij_original ]; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: int_result[ ij_result ] = int_y[ ij_original ]; //INTEGER(result)[ ij_result ] = INTEGER(y)[ ij_original ]; break; case REALSXP: //REAL(result)[ ij_result ] = REAL(y)[ ij_original ]; real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } xp++; yp++; } else //if( INTEGER(xindex)[ xp-1 ] < INTEGER(yindex)[ yp-1 ] ) { if( int_xindex[ xp-1 ] < int_yindex[ yp-1 ] ) { if(left_join) { //copyIndex(index, xindex, i, xp-1); //INTEGER(index)[ i ] = INTEGER(xindex)[ xp-1 ]; int_index[ i ] = int_xindex[ xp-1 ]; for(j = 0; j < ncx; j++) { // x-values ij_result = i + j * num_rows; ij_original = (xp-1) + j * nrx; //num_rows; //REAL(result)[ ij_result ] = REAL(x)[ ij_original ]; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ]; break; case INTSXP: //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ]; int_result[ ij_result ] = int_x[ ij_original ]; break; case REALSXP: //REAL(result)[ ij_result ] = REAL(x)[ ij_original ]; real_result[ ij_result ] = real_x[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original)); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { /* y-values */ ij_result = i + (j+ncx) * num_rows; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; break; case INTSXP: int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); break; default: error("unsupported data type"); break; } } } xp++; if(!left_join) i--; } else //if( INTEGER(xindex)[ xp-1 ] > INTEGER(yindex)[ yp-1 ] ) { if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) { if(right_join) { //INTEGER(index)[ i ] = INTEGER(yindex)[ yp-1 ]; int_index[ i ] = int_yindex[ yp-1 ]; for(j = 0; j < ncx; j++) { // x-values ij_result = i + j * num_rows; //REAL(result)[ ij_result ] = NA_REAL; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; //NA_INTEGER; break; case INTSXP: int_result[ ij_result ] = int_fill; break; case REALSXP: REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; //NA_REAL; break; case CPLXSXP: COMPLEX(result)[ ij_result ].r = COMPLEX(fill)[ 0 ].r; COMPLEX(result)[ ij_result ].i = COMPLEX(fill)[ 0 ].i; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); //NA_STRING); break; default: error("unsupported data type"); break; } } for(j = 0; j < ncy; j++) { // y-values ij_result = i + (j+ncx) * num_rows; ij_original = (yp-1) + j * nry; //num_rows; //REAL(result)[ ij_result ] = REAL(y)[ ij_original ]; switch( mode ) { case LGLSXP: LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ]; break; case INTSXP: //INTEGER(result)[ ij_result ] = INTEGER(y)[ ij_original ]; int_result[ ij_result ] = int_y[ ij_original ]; break; case REALSXP: //REAL(result)[ ij_result ] = REAL(y)[ ij_original ]; real_result[ ij_result ] = real_y[ ij_original ]; break; case CPLXSXP: COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ]; break; case STRSXP: SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original)); break; default: error("unsupported data type"); break; } } } yp++; if(!right_join) i--; } } } /* following logic to allow for dimensionless xts objects (unsupported) to be used in Ops.xts calls This maps to how zoo behaves */ if(LOGICAL(retside)[0] && !LOGICAL(retside)[1] && isNull(getAttrib(x,R_DimSymbol))) { /* retside=c(T,F) AND is.null(dim(x)) */ setAttrib(result, R_DimSymbol, R_NilValue); } else if(LOGICAL(retside)[1] && !LOGICAL(retside)[0] && isNull(getAttrib(y,R_DimSymbol))) { /* retside=c(F,T) AND is.null(dim(y)) */ setAttrib(result, R_DimSymbol, R_NilValue); } else /* set Dim and DimNames if there is at least 1 column */ if((ncx + ncy) > 0) { /* DIM */ PROTECT(attr = allocVector(INTSXP, 2)); INTEGER(attr)[0] = num_rows; INTEGER(attr)[1] = ncx + ncy; setAttrib(result, R_DimSymbol, attr); UNPROTECT(1); /* DIMNAMES */ if(!isNull(colnames)) { // only set DimNamesSymbol if passed colnames is not NULL SEXP newcolnames = PROTECT(xts_merge_combine_dimnames(x, y, ncx, ncy, colnames)); p++; newcolnames = PROTECT(xts_merge_make_colnames(newcolnames, suffixes, check_names, env)); p++; SEXP dimnames = PROTECT(allocVector(VECSXP, 2)); p++; SET_VECTOR_ELT(dimnames, 0, R_NilValue); SET_VECTOR_ELT(dimnames, 1, newcolnames); setAttrib(result, R_DimNamesSymbol, dimnames); } } else { // only used for zero-width results! xts always has dimension setAttrib(result, R_DimSymbol, R_NilValue); } setAttrib(result, xts_IndexSymbol, index); if(LOGICAL(retclass)[0]) setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol)); setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol)); copy_xtsAttributes(x, result); UNPROTECT(p); return result; } //}}} //SEXP mergeXts (SEXP all, SEXP fill, SEXP retclass, SEXP colnames, SEXP retside, SEXP env, SEXP args) /* called via .External("mergeXts", ...) */ SEXP mergeXts (SEXP args) // mergeXts {{{ { SEXP _x, _y, xtmp, result, _INDEX; /* colnames should be renamed as suffixes, as colnames need to be added at the C level */ SEXP all, fill, retc, retclass, symnames, suffixes, rets, retside, env, tzone, check_names; int nr, nc, ncs=0; int index_len; int i, n=0, P=0; SEXP argstart; args = CDR(args); all = CAR(args); args = CDR(args); fill = CAR(args); args = CDR(args); retclass = CAR(args); args = CDR(args); symnames = CAR(args); args = CDR(args); suffixes = CAR(args); args = CDR(args); retside = CAR(args); args = CDR(args); env = CAR(args); args = CDR(args); tzone = CAR(args); args = CDR(args); check_names = CAR(args); args = CDR(args); // args should now correspond to the ... objects we are looking to merge argstart = args; // use this to rewind list... n = 0; int type_of; SEXP coerce = PROTECT(ScalarInteger(0)); P++; if(args != R_NilValue) type_of = TYPEOF(CAR(args)); // number of columns in the output while(args != R_NilValue) { ncs += xts_ncols(CAR(args)); if(length(CAR(args)) > 0) { /* need to convert all objects if one non-zero-width needs to be converted */ if(TYPEOF(CAR(args)) != type_of) { INTEGER(coerce)[0] = 1; } } args = CDR(args); n++; } /* build an index to be used in all subsequent calls */ args = argstart; _x = CAR(args); args = CDR(args); int leading_non_xts = 0; while( !Rf_asInteger(isXts(_x)) ) { if( args == R_NilValue ) error("no xts object to merge"); leading_non_xts = 1; /*warning("leading non-xts objects may have been dropped");*/ _x = CAR(args); args = CDR(args); } /* test for NULLs that may be present from cbind dispatch */ if(!leading_non_xts) { /* leading non-xts in 2 case scenario was igoring non-xts value */ if(n < 3 && (args == R_NilValue || (isNull(CAR(args)) && length(args) == 1))) {/* no y arg or y==NULL */ UNPROTECT(P); return(_x); } } if( args != R_NilValue) { _y = CAR(args); args = CDR(args); } else { PROTECT(_y = duplicate(_x)); P++; } if(n > 2 || leading_non_xts) { /*args != R_NilValue) {*/ /* generalized n-case optimization currently if n>2 this is faster and more memory efficient than recursively building a merged object, object by object. */ PROTECT(retc = allocVector(LGLSXP, 1)); P++; LOGICAL(retc)[0] = 1; /* return class == TRUE */ PROTECT(rets = allocVector(LGLSXP, 2)); P++; LOGICAL(rets)[0] = 0; /* don't return left */ LOGICAL(rets)[1] = 0; /* don't return right */ if( isNull(_y) ) { PROTECT(_y = duplicate(_x)); P++; } // REPROTECT _INDEX in while loop PROTECT_INDEX idx; PROTECT_WITH_INDEX(_INDEX = do_merge_xts(_x, _y, all, fill, retc, R_NilValue, R_NilValue, rets, check_names, env, coerce), &idx); P++; /* merge all objects into one zero-width common index */ while(args != R_NilValue) { if( !isNull(CAR(args)) ) { REPROTECT(_INDEX = do_merge_xts(_INDEX, CAR(args), all, fill, retc, R_NilValue, R_NilValue, rets, check_names, env, coerce), idx); } args = CDR(args); } index_len = length(GET_xtsIndex(_INDEX)); args = argstart; // reset args int ii, jj, iijj, jj_result; PROTECT(result = allocVector(TYPEOF(_INDEX), index_len * ncs)); P++; SEXP ColNames, NewColNames; PROTECT(NewColNames = allocVector(STRSXP, ncs)); P++; ncs = 0; // REPROTECT xtmp inside for loop PROTECT_INDEX idxtmp, cnmtmp; PROTECT_WITH_INDEX(xtmp = NULL, &idxtmp); P++; PROTECT_WITH_INDEX(ColNames = NULL, &cnmtmp); P++; for(i = 0, nc=0; args != R_NilValue; i = i+nc, args = CDR(args)) { // merge each object with index // i is object current being merged/copied // nc is offset in current object if( isNull(CAR(args)) ) { i = i-nc; continue; // if NULL is passed, skip to the next object. } REPROTECT(xtmp = do_merge_xts(_INDEX, CAR(args), all, fill, retclass, /*colnames*/R_NilValue, R_NilValue, retside, check_names, env, coerce), idxtmp); nr = nrows(xtmp); nc = xts_ncols(xtmp); ncs += nc; /* Use colnames from merged object, if it has them. Otherwise, use * use deparsed names */ REPROTECT(ColNames = getAttrib(CAR(args),R_DimNamesSymbol), cnmtmp); SEXP colnames = R_NilValue; if(R_NilValue != ColNames) { colnames = VECTOR_ELT(ColNames, 1); } if(R_NilValue == colnames) { for(jj=0; jj < nc; jj++) { SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(symnames,i+jj)); } } else { for(jj=0; jj < nc; jj++) { SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(colnames, jj)); } } switch(TYPEOF(xtmp)) { // by type, insert merged data into result object case LGLSXP: { int *xtmp_ = LOGICAL(xtmp); int *result_ = LOGICAL(result); for(jj=0; jj < nc; jj++) { for(ii=0; ii < nr; ii++) { iijj = ii + jj * nr; jj_result = ii + (i+jj) * nr; result_[jj_result] = xtmp_[iijj]; } } } break; case INTSXP: { int *xtmp_ = INTEGER(xtmp); int *result_ = INTEGER(result); for(jj=0; jj < nc; jj++) { for(ii=0; ii < nr; ii++) { iijj = ii + jj * nr; jj_result = ii + (i+jj) * nr; result_[jj_result] = xtmp_[iijj]; } } } break; case REALSXP: { double *xtmp_ = REAL(xtmp); double *result_ = REAL(result); for(jj=0; jj < nc; jj++) { for(ii=0; ii < nr; ii++) { iijj = ii + jj * nr; jj_result = ii + (i+jj) * nr; result_[jj_result] = xtmp_[iijj]; } } } break; case CPLXSXP: { Rcomplex *xtmp_ = COMPLEX(xtmp); Rcomplex *result_ = COMPLEX(result); for(jj=0; jj < nc; jj++) { for(ii=0; ii < nr; ii++) { iijj = ii + jj * nr; jj_result = ii + (i+jj) * nr; result_[jj_result] = xtmp_[iijj]; } } } break; case STRSXP: { for(jj=0; jj < nc; jj++) { for(ii=0; ii < nr; ii++) { iijj = ii + jj * nr; jj_result = ii + (i+jj) * nr; SET_STRING_ELT(result, jj_result, STRING_ELT(xtmp, iijj)); } } } break; default: error("unsupported data type"); break; } } if(ncs > 0) { SEXP dim; PROTECT(dim = allocVector(INTSXP, 2)); P++; INTEGER(dim)[0] = index_len; INTEGER(dim)[1] = ncs; setAttrib(result, R_DimSymbol, dim); PROTECT(NewColNames = xts_merge_make_colnames(NewColNames, suffixes, check_names, env)); P++; SEXP dimnames = PROTECT(allocVector(VECSXP, 2)); P++; SET_VECTOR_ELT(dimnames, 0, R_NilValue); SET_VECTOR_ELT(dimnames, 1, NewColNames); setAttrib(result, R_DimNamesSymbol, dimnames); } SET_xtsIndex(result, GET_xtsIndex(_INDEX)); copy_xtsCoreAttributes(_INDEX, result); copy_xtsAttributes(_INDEX, result); } else { /* 2-case optimization --- simply call main routine */ /* likely bug in handling of merge(1, xts) case */ PROTECT(result = do_merge_xts(_x, _y, all, fill, retclass, symnames /*R_NilValue*/, suffixes, retside, check_names, env, coerce)); P++; } SEXP index_tmp = getAttrib(result, xts_IndexSymbol); PROTECT(index_tmp); P++; if(isNull(tzone)) { setAttrib(index_tmp, xts_IndexTzoneSymbol, getAttrib(getAttrib(_x,xts_IndexSymbol), xts_IndexTzoneSymbol)); } else { setAttrib(index_tmp, xts_IndexTzoneSymbol, tzone); } copyMostAttrib(getAttrib(_x,xts_IndexSymbol), index_tmp); setAttrib(result, xts_IndexSymbol, index_tmp); UNPROTECT(P); return(result); } //}}} end of mergeXts xts/vignettes/0000755000176200001440000000000014552546765013123 5ustar liggesusersxts/vignettes/xts.Rnw0000644000176200001440000010065414522244666014427 0ustar liggesusers%\VignetteIndexEntry{xts: Extensible Time Series} \documentclass{article} \usepackage{hyperref} \hypersetup{colorlinks,% citecolor=black,% linkcolor=blue,% urlcolor=blue,% } \title{\bf xts: Extensible Time Series } \author{Jeffrey A. Ryan \and Joshua M. Ulrich} \date{May 18, 2008} \begin{document} \maketitle \tableofcontents \section{Introduction} The statistical language {\tt R}~\cite{R} offers the time-series analyst a variety of mechanisms to both store and manage time-indexed data. Native {\tt R} classes potentially suitable for time-series data include {\tt data.frame}, {\tt matrix}, {\tt vector}, and {\tt ts} objects. Additional time-series tools have been subsequently introduced in contributed packages to handle some of the domain-specific shortcomings of the native {\tt R} classes. These include {\tt irts} from the {\tt tseries} package\cite{tseries}, {\tt timeSeries} from the {\tt Rmetrics} bundle\cite{rmetrics}, and {\tt zoo}~\cite{zoo} from their respective packages. Each of these contributed classes provides unique solution to many of the issues related to working with time-series in R. While it seems a bit paradoxical with all the current options available, what {\tt R} really needed was one more time-series class. Why? Users of R have had many choices over the years for managing time-series data. This variety has meant that developers have had to pick and choose the classes they would support, or impose the necessary conversions upon the end-user. With the sheer magnitude of software packages available from CRAN, it has become a challenge for users and developers to select a time-series class that will manage the needs of the individual user, as well as remain compatible with the broadest audience. What may be sufficient for one use --- say a quick correlation matrix may be too limiting when more information needs to be incorporated in a complex calculation. This is especially true for functions that rely on time-based indexes to be manipulated or checked. The previous solution to managing different data needs often involved a series of {\tt as} calls, to coerce objects from one type to another. While this may be sufficient for many cases, it is less flexible than allowing the users to simply use the object they are accustomed to, or quite possibly require. Additionally, all current coercion methods fail to maintain the original object's data in its entirety. Converting from a {\tt timeSeries} class to {\tt zoo} would cause attributes such as {\em FinCenter}, {\em format}, and {\em recordIDs} to be lost. Converting back to a {\tt timeSeries} would then add new values different than the original. For many calculations that do not modify the data, this is most likely an acceptable side effect. For functions that convert data --- such as {\tt xts}'s {\tt to.period} --- it limits the value of the function, as the returned object is missing much of what may have been a factor in the original class consideration. One of the most important additions the new {\tt xts} class makes to the R user's workflow doesn't use {\tt xts} at all, at least not explicitly. By converting data to {\tt xts} inside a function, the function developer is guaranteed to have to only manage a single class of objects. It becomes unecessary to write specific methods to handle different data. While many functions do have methods to accommodate different classes, most do not. Before {\tt xts}, the {\tt chartSeries} function in the {\tt quantmod} package\cite{quantmod} was only able to handle {\tt zoo} objects well. Work had been done to allow for {\tt timeSeries} objects to be used as well, but many issues were still being worked out. With {\tt xts} now used internally, it is possible to use \emph{any} of R's time-series classes. Simultaneously saving development time and reducing the learning/using curve for the end user. The function now simply handles whatever time-series object it receives exactly as the user expects --- without complaint. More details, as well as examples of incorporating {\tt xts} into functions will be covered later in this document. While it may seem that {\tt xts} is primarily a tool to help make existing R code more user-friendly, the opportunity to add exciting (to software people) new functionality could not be passed up. To this end, {\tt xts} offers the user the ability to add custom attributes to any object --- during its construction or at any time thereafter. Additionally, by requiring that the index attribute be derived from one of R's existing time-based classes, {\tt xts} methods can make assumptions, while subsetting by time or date, that allow for much cleaner and accurate data manipulation. The remainder of this introduction will examine what an {\tt xts} object consists of and its basic usage, explain how developing with {\tt xts} can save package development time, and finally will demonstrate how to extend the class - informally and formally. \pagebreak \section{The structure of {\tt xts}} To understand a bit more of \emph{what an xts object can do}, it may be beneficial to know \emph{what an xts object is}. This section is intended to provide a quick overview of the basics of the class, as well as what features make it unique. \subsection{It's a {\tt zoo} in here} At the core of an {\tt xts} object is a {\tt zoo} object from the package of the same name. Simplified, this class contains an array of values comprising your data (often in matrix form) and an index attribute to provide information about the data's ordering. Most of the details surrounding zoo objects apply equally to xts. As it would be redundent to simply retell the excellent introductory zoo vignette, the reader is advised to read, absorb, and re-read that documentation to best understand the power of this class. The authors of the {\tt xts} package recognize that {\tt zoo}'s strength comes from its simplicity of use, as well as its overall flexibility. What motivated the {\tt xts} extension was a desire to have even more flexibility, while imposing reasonable constraints to make this class into a true time-based one. \subsection{{\tt xts} modifications} Objects of class {\tt xts} differ from objects of class {\tt zoo} in three key ways: the use of formal time-based classes for indexing, internal xts properties, and perhaps most uniquely --- user-added attributes. \subsubsection*{True time-based indexes} To allow for functions that make use of {\tt xts} objects as a general time-series object - it was necessary to impose a simple rule on the class. The index of each {\tt xts} object \emph{must} be of a known and supported time or date class. At present this includes any one of the following - Date, POSIXct, chron, yearmon, yearqtr, or timeDate. The relative merits of each are left to the judgement of the user, though the first three are expected to be sufficient for most applications. \subsubsection*{Internal attributes: .CLASS, .ROWNAMES, etc.} In order for one major feature of the {\tt xts} class to be possible - the conversion and re-conversion of classes to and from {\tt xts} - certain elements must be preserved within the converted object. These are for internal use, and as such require little further explanation in an introductory document. Interested readers are invited to examine the source as well as read the developer documentation. \subsubsection*{xtsAttributes} This is what makes the xts class an \emph{extensible} time-series class. Arbitrary attributes may be assigned and removed from the object without causing issues with the data's display or otherwise. Additionally this is where \emph{other} class specific attributes (e.g. \emph{FinCenter} from {\tt timeSeries}) are stored during conversion to an xts object so they may be restored with {\tt reclass}. \pagebreak \section{Using the {\tt xts} package} Just what is required to start using {\tt xts}? Nothing more than a simple conversion of your current time-series data with {\tt as.xts}, or the creation of a new object with the {\tt xts} constructor. \subsection{Creating data objects: {\tt as.xts} and {\tt xts}} There are two equally valid mechanisms to create an {\tt xts} object - coerce a supported time-series class to {\tt xts} with a call to {\tt as.xts} or create a new object from scratch with {\tt xts}. \subsubsection*{Converting your \emph{existing} time-series data: {\tt as.xts}} If you are already comfortable using a particular time-series class in {\tt R}, you can still access the functionality of {\tt xts} by converting your current objects. Presently it is possible to convert all the major time-series like classes in {\tt R} to {\tt xts}. This list includes objects of class: matrix, data.frame, ts, zoo, irts, and timeSeries. The new object will maintain all the necessary information needed to {\tt reclass} this object back to its original class if that is desired. Most classes after re-conversion will be identical to similar modifications on the original object, even after sub-setting or other changes while an {\tt xts} object. <>= require(xts) data(sample_matrix) class(sample_matrix) str(sample_matrix) matrix_xts <- as.xts(sample_matrix,dateFormat='Date') str(matrix_xts) df_xts <- as.xts(as.data.frame(sample_matrix), important='very important info!') str(df_xts) @ A few comments about the above. {\tt as.xts} takes different arguments, depending on the original object to be converted. Some classes do not contain enough information to infer a time-date class. If that is the case, POSIXct is used by default. This is the case with both matrix and data.frame objects. In the preceding examples we first requested that the new date format be of type 'Date'. The second example was left to the default {\tt xts} method with a custom attribute added. \subsubsection*{Creating new data: the {\tt xts} constructor} Data objects can also be constructed directly from raw data with the {\tt xts} constructor function, in essentially the same way a {\tt zoo} object is created with the exception that at present there is no equivelant {\tt zooreg} class. <>= xts(1:10, Sys.Date()+1:10) @ \subsection{{\tt xts} methods} There is a full complement of standard methods to make use of the features present in {\tt xts} objects. The generic methods currently extended to {\tt xts} include ``{\tt [}'', {\tt cbind}, {\tt rbind}, {\tt c}, {\tt str}, {\tt Ops}, {\tt print}, {\tt na.omit}, {\tt time}, {\tt index}, {\tt plot} and {\tt coredata}. In addition, most methods that can accept zoo or matrix objects will simply work as expected. A quick tour of some of the methods leveraged by {\tt xts} will be presented here, including subsetting via ``{\tt [}'', indexing objects with {\tt tclass} and {\tt convertIndex}, and a quick look at plotting {\tt xts} objects with the {\tt plot} function. \subsubsection*{Subsetting} The most noticable difference in the behavior of \texttt{xts} objects will be apparent in the use of the ``{\tt [}'' operator. Using special notation, one can use date-like strings to extract data based on the time-index. Using increasing levels of time-detail, it is possible to subset the object by year, week, days - or even seconds. The {\em i} (row) argument to the subset operator ``{\tt [}'', in addition to accepting numeric values for indexing, can also be a character string, a time-based object, or a vector of either. The format must left-specified with respect to the standard ISO:8601 time format --- {\em ``CCYY-MM-DD HH:MM:SS''}~\cite{ISO}. This means that for one to extract a particular month, it is necesssary to fully specify the year as well. To identify a particular hour, say all observations in the eighth hour on January 1, 2007, one would likewise need to include the full year, month and day - e.g. ``2007-01-01 08''. It is also possible to explicitly request a range of times via this index-based subsetting, using the ISO-recommended ``/'' as the range seperater. The basic form is {\em ``from/to''}, where both {\em from} and {\em to} are optional. If either side is missing, it is interpretted as a request to retrieve data from the beginning, or through the end of the data object. Another benefit to this method is that exact starting and ending times need not match the underlying data - the nearest available observation will be returned that is within the requested time period. The following example shows how to extract the entire month of March 2007 - without having to manually identify the index positions or match the underlying index type. The results have been abbreviated to save space. <>= matrix_xts['2007-03'] @ <>= head(matrix_xts['2007-03'],5) cat('...\n') @ Now extract all the data from the beginning through January 7, 2007. <>= matrix_xts['/2007-01-07'] @ <>= matrix_xts['/2007-01-07'] @ Additional xts tools providing subsetting are the {\tt first} and {\tt last} functions. In the spirit of head and tail from the {\em utils} recommended package, they allow for string based subsetting, without forcing the user to conform to the specifics of the time index, similar in usage to the {\em by} arguments of {\tt aggregate.zoo} and {\tt seq.POSIXt}. Here is the first 1 week of the data <>= first(matrix_xts,'1 week') @ <>= head(first(matrix_xts,'1 week')) @ ...and here is the first 3 days of the last week of the data. <>= first(last(matrix_xts,'1 week'),'3 days') @ \subsubsection*{Indexing} While the subsetting ability of the above makes exactly {\em which} time-based class you choose for your index a bit less relevant, it is none-the-less a factor that is beneficial to have control over. To that end, {\tt xts} provides facilities for indexing based on any of the current time-based classes. These include {\tt Date}, {\tt POSIXct}, {\tt chron}, {\tt yearmon}, {\tt yearqtr}, and {\tt timeDate}. The index itself may be accessed via the zoo generics extended to xts --- {\tt index} and the replacement function {\tt index<-}. It is also possible to directly query and set the index class of an {\tt xts} object by using the respective functions {\tt tclass} and {\tt tclass<-}. Temporary conversion, resulting in a new object with the requested index class, can be accomplished via the {\tt convertIndex} function. <>= tclass(matrix_xts) tclass(convertIndex(matrix_xts,'POSIXct')) @ \pagebreak \subsubsection*{Plotting} \SweaveOpts{height=5,width=10} %\setkeys{Gin}{width=0.8\textwidth} The use of time-based indexes within {\tt xts} allows for assumptions to be made regarding the x-axis of plots. The {\tt plot} method makes use of the {\tt xts} function {\tt axTicksByTime}, which heuristically identifies suitable tickmark locations for printing given a time-based object. When {\tt axTickByTime} is called with its {\tt ticks.on} argument set to ``auto'', the result is a vector of suitably chosen tickmark locations. One can also specify the specific points to use by passing a character string to the argument indicating which time period to create tickmarks on. <>= axTicksByTime(matrix_xts, ticks.on='months') @ A simple example of the plotting functionality offered by this labelling can be seen here: \begin{center} <>= plot(matrix_xts[,1],major.ticks='months',minor.ticks=FALSE,main=NULL,col=3) @ \end{center} \subsection{Restoring the original class - {\tt reclass} \& {\tt Reclass}} By now you may be interested in some of the xts functionality presented, and wondering how to incorporate it into a current workflow --- but not yet ready to commit to using it exclusively. If it is desirable to only use the subsetting tools for instance, a quick conversion to xts via {\tt as.xts} will allow full access to the above subsetting tools. When it is then necessary to continue your analysis using the original class, it is as simple as calling the function {\tt reclass} to return the object to its original class. \subsubsection*{(Re)converting classes manually: {\tt reclass}} <>= # using xts-style subsetting doesn't work on non-xts objects sample_matrix['2007-06'] # convert to xts to use time-based subsetting str(as.xts(sample_matrix)['2007-06']) # reclass to get to original class back str(reclass(as.xts(sample_matrix)['2007-06'])) @ This differs dramatically from the standard {\tt as.*****} conversion though. Internally, key attributes of your original data object are preserved and adjusted to assure that the process introduces no changes other than those requested. Think of it as a smart {\tt as}. Behind the scenes, {\tt reclass} has enormous value in functions that convert all incoming data to {\tt xts} for simplified processing. Often it is necessary to return an object back to the user in the class he is expecting --- following the principal of least surprise. It is in these circumstances where {\tt reclass} can turn hours of tedious development into mere minutes per function. More details on the details of using this functionality for developers will be covered in section \ref{developer}, \textbf{Developing with xts}. A user friendly interface of this \emph{reclass} functionality, though implicit, is available in the {\tt Reclass} function. It's purpose is to make it easy to preserve an object's attributes after calling a function that is not programmed to be aware of your particular class. \pagebreak \subsubsection*{Letting xts handle the details: {\tt Reclass}} If the function you require does not make use of {\tt reclass} internally, it may still be possible to let xts convert and reconvert your time-based object for you. The caveat here is that the object returned: \begin{quote} \begin{itemize} \item must be of the same length as the first argument to the function. \item intended to be coerced back to the class of the first argument \end{itemize} \end{quote} Simply wrapping the function that meets these criteria in {\tt Reclass} will result in an attempt to coerce the returned output of the function <>= z <- zoo(1:10,Sys.Date()+1:10) # filter converts to a ts object - and loses the zoo class (zf <- filter(z, 0.2)) class(zf) # using Reclass, the zoo class is preserved (zf <- Reclass(filter(z, 0.2))) class(zf) @ The {\tt Reclass} function is still a bit experimental, and will certainly improve in time, but for now provides at least an alternative option to maintain your object's class and attributes when the function you require can't on its own. \subsection{Additional time-based tools} In addition to the core {\tt xts} tools covered above, there are more functions that are included in xts to make the process of dealing with time-series data easier. Some of these have been moved from the package {\tt quantmod} to {\tt xts} to make it easier to use them within other applications. \subsubsection*{Calculate periodicity} The {\tt periodicity} function provides a quick summary as to the underlying periodicity of most time-series like objects. Primarily a wrapper to {\tt difftime} it provides a quick and concise summary of your data. <>= periodicity(matrix_xts) @ \subsubsection*{Find endpoints by time} Another common issue with time-series data is identifying the endpoints with respect to time. Often it is necessary to break data into hourly or monthly intervals to calculate some statistic. A simple call to {\tt endpoints} offers a quick vector of values suitable for subsetting a dataset by. Note that the first element it zero, which is used to delineate the \emph{end}. <>= endpoints(matrix_xts,on='months') endpoints(matrix_xts,on='weeks') @ \subsubsection*{Change periodicity} One of the most ubiquitous type of data in finance is OHLC data (Open-High-Low-Close). Often is is necessary to change the periodicity of this data to something coarser - e.g. take daily data and aggregate to weekly or monthly. With {\tt to.period} and related wrapper functions it is a simple proposition. <>= to.period(matrix_xts,'months') periodicity(to.period(matrix_xts,'months')) # changing the index to something more appropriate to.monthly(matrix_xts) @ The {\tt to.monthly} wrapper automatically requests that the returned object have an index/rownames using the {\tt yearmon} class. With the {\tt indexAt} argument it is possible to align most series returned to the end of the period, the beginning of the period, or the first or last observation of the period --- even converting to something like {\tt yearmon} is supported. The online documentation provides more details as to additional arguments. \subsubsection*{Periodically apply a function} Often it is desirable to be able to calculate a particular statistic, or evaluate a function, over a set of non-overlapping time periods. With the {\tt period.apply} family of functions it is quite simple. The following examples illustrate a simple application of the {\tt max} function to our example data. <>= # the general function, internally calls sapply period.apply(matrix_xts[,4],INDEX=endpoints(matrix_xts),FUN=max) @ <>= # same result as above, just a monthly interface apply.monthly(matrix_xts[,4],FUN=max) @ <>= # using one of the optimized functions - about 4x faster period.max(matrix_xts[,4], endpoints(matrix_xts)) @ In addition to {\tt apply.monthly}, there are wrappers to other common time frames including: {\tt apply.daily}, {\tt apply.weekly}, {\tt apply.quarterly}, and {\tt apply.yearly}. Current optimized functions include {\tt period.max}, {\tt period.min}, {\tt period.sum}, and {\tt period.prod}. \pagebreak \section{Developing with {\tt xts}} \label{developer} While the tools available to the xts \emph{user} are quite useful, possibly greater utility comes from using xts internally as a \emph{developer}. Bypassing traditional S3/S4 method dispatch and custom if-else constructs to handle different time-based classes, {\tt xts} not only makes it easy to handle all supported classes in one consistent manner, it also allows the whole process to be invisible to the function user. \subsection{One function for all classes: {\tt try.xts}} With the proliferation of data classes in R, it can be tedious, if not entirely impractical, to manage interfaces to all classes. Not only does trying to handle every possible class present non-trivial design issues, the developer is also forced to learn and understand the nuances of up to eight or more classes. For each of these classes it is then ncessary to write and manage corresponding methods for each case. At best, this reduces the time available to devote to core function functionality --- at worst is a prime opportunity to introduce errors that inevitibly come from this massive increase in code. The solution to this issue is to use one class internally within your package, or more generally your entire workflow. This can be accomplished in one of two ways: force your users to adopt the convention you do, or allow for multiple object classes by relying on internal code to convert to one consistent type. Using the second approach offers the most end-user flexibility, as class conversions are no longer required simply to make use of package functionality. The user's own workflow need not be interrupted with unproductive and potentially error-prone conversions and reconversions. Using the functionality of {\tt try.xts} and {\tt reclass} offered by the xts package allows the developer an opportunity to cleanly, and reliably, manage data with the least amount of code, and the least number of artificial end-user restrictions. An example from the xts package illustrates just how simple this can be. <>= period.apply @ Some explanation of the above code is needed. The {\tt try.xts} function takes three arguments, the first is the object that the developer is trying to convert, the second \ldots is any additional arguments to the {\tt as.xts} constructor that is called internally (ignore this for the most part --- though it should be noted that this is an R dots argument \ldots), and the third is a what the result of an error should be. Of the three, {\tt error} is probably the most useful from a design standpoint. Some functions may not be able to deal with data that isn't time-based. Simple numerical vectors might not contain enough information to be of any use. The \emph{error} argument lets the developer decide if the function should be halted at this point, or continue onward. If a logical value, the result is handled by R's standard error mechanism during the try-catch block of code internal to {\tt try.xts}. If error is a character string, it is returned to the standard output as the message. This allows for diagnostic messages to be fine tuned to your particular application. The result of this call, if successful (or if {\tt error=FALSE}) is an object that may be of class {\tt xts}. If your function can handle either numeric data or time-based input, you can branch code here for cases you expect. If your code has been written to be more general at this point, you can simply continue with your calculations, the originally converted object will contain the information that will be required to reclass it at the end. A note of importance here: if you are planning on returning an object that is of the original class, it is important to not modify the originally coverted object - in this case that would be the {\tt x} result of the {\tt try.xts} call. You will notice that the function's result is assigned to {\tt xx} so as not to impact the original converted function. If this is not possible, it is recommended to copy the object first to preserve an untouched copy for use in the {\tt reclass} function. Which leads to the second part of the process of developing with xts. \subsection{Returning the original class: {\tt reclass}} The {\tt reclass} function takes the object you are expecting to return to your user (the result of all your calculations) and optionally an {\tt xts} object that was the result of the original {\tt try.xts} call. It is important to stress that the {\tt match.to} object \emph{must be an untouched object} returned from the {\tt try.xts} call. The only exception here is when the resultant data has changed dimension --- as is the case in the {\tt period.apply} example. As reclass will try and convert the first argument to the orginal class of the second (the original class passed to the function), it must have the same general row dimension of the original. A final note on using {\tt reclass}. If the {\tt match.to} argument is left off, the conversion will only be attempted if the object is of class {\tt xts} and has a {\tt CLASS} attribute that is not {\tt NULL}, else the object is simply returned. Essentially if the object meant to be reconverted is already of in the form needed by the individual reclass methods, generally nothing more needs to be done by the developer. In many cases your function does not need to return an object that is expected to be used in the same context as the original. This would be the case for functions that summarize an object, or perform some statistical analysis. For functions that do not need the {\tt reclass} functionality, a simple use of {\tt try.xts} at the beginning of the function is all that is needed to make use of this single-interface tool within {\tt xts}. Further examples can be found in the {\tt xts} functions {\tt periodicity} and {\tt endpoints} (no use of reclass), and {\tt to.period} (returns an object of the original's class). The package {\tt quantmod} also utilizes the {\tt try.xts} functionality in its {\tt chartSeries} function --- allowing financial charts for all time-based classes. Forthcoming developer documentation will examine the functions highlighted above, as well go into more detail on exceptional cases and requirements. \pagebreak \section{Customizing and Extending xts} As \emph{extensible} is in the name of the package, it is only logical that it can be extended. The two obvious mechanisms to make {\tt xts} match the individual needs of a diverse user base is the introduction of custom attributes, and the idea of subclassing the entire {\tt xts} class. \subsection{{\tt xtsAttributes}} What makes an R attribute an {\tt xtsAttribute}? Beyond the sematics, xtsAttributes are designed to persist once attached to an object, as well as not get in the way of other object functionality. All xtsAttributes are indeed R attributes, though the same can not be said of the reverse --- all R attributes are \emph{not} xtsAttributes! Attaching arbitrary attributes to most (all?) classes other than {\tt xts} will cause the attribute to be displayed during most calls that print the object. While this isn't necessarily devestating, it is often time unsightly, and sometimes even confusing to the end user (this may depend on the quality your users). xts offers the developer and end-user the opportunity to attach attributes with a few different mechanisms - and all will be suppressed from normal view, unless specifically called upon. What makes an xtsAttribute special is that it is principally a mechanism to store and view meta-data, that is, attributes that would be seen with a call to R's {\tt attributes}. <>= str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) # attach some attributes xtsAttributes(matrix_xts) <- list(myattr="my meta comment") attr(matrix_xts, 'another.item') <- "one more thing..." str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) @ In general - the only attributes that should be handled directly by the user (\emph{without} the assistance of xts functions) are ones returned by {\tt xtsAttributes}. The additional attributes seen in the {\tt attributes} example are for internal R and xts use, and if you expect unbroken code, should be left alone. \subsection{Subclassing {\tt xts}} Subclassing xts is as simple as extending any other S3 class in R. Simply include the full class of the xts system in your new class. <>= xtssubclass <- structure(matrix_xts, class=c('xts2','xts','zoo')) class(xtssubclass) @ This will allow the user to override methods of xts and zoo, while still allowing for backward compatibility with all the tools of xts and zoo, much the way {\tt xts} benefits from extending {\tt zoo}. \section{Conclusion} The {\tt xts} package offers both R developers and R users an extensive set of time-aware tools for use in time-based applications. By extending the {\tt zoo} class, xts leverages an excellent infrastructure tool into a true time-based class. This simple requirement for time-based indexing allows for code to make assumptions about the object's purpose, and facilitates a great number of useful utilities --- such as time-based subsetting. Additionally, by embedding knowledge of the currently used time-based classes available in R, xts can offer the developer and end-user a single interface mechanism to make internal class decisions user-driven. This affords developers an opportunity to design applications for there intended purposes, while freeing up time previously used to manage the data structures. Future development of xts will focus on integrating xts into more external packages, as well as additional useful additions to the time-based utilities currently available within the package. An effort to provide external disk and memory based data access will also be examined for potential inclusion or extension. \begin{thebibliography}{99} \bibitem{zoo} Achim Zeileis and Gabor Grothendieck (2005): \emph{ zoo: S3 Infrastructure for Regular and Irregular Time Series.} Journal of Statistical Software, 14(6), 1-27. URL http://www.jstatsoft.org/v14/i06/ \bibitem{tseries} Adrian Trapletti and Kurt Hornik (2007): \emph{tseries: Time Series Analysis and Computational Finance.} R package version 0.10-11. \bibitem{rmetrics} Diethelm Wuertz, many others and see the SOURCE file (2007): \emph{Rmetrics: Rmetrics - Financial Engineering and Computational Finance.} R package version 260.72. http://www.rmetrics.org \bibitem{ISO} International Organization for Standardization (2004): \emph{ISO 8601: Data elements and interchage formats --- Information interchange --- Representation of dates and time} URL http://www.iso.org \bibitem{R} R Development Core Team: \emph{R: A Language and Environment for Statistical Computing}, R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, URL http://www.R-project.org \bibitem{quantmod} Jeffrey A. Ryan (2008): \emph{quantmod: Quantitative Financial Modelling Framework.} R package version 0.3-5. URL http://www.quantmod.com URL http://r-forge.r-project.org/projects/quantmod \end{thebibliography} \end{document} xts/vignettes/xts-faq.Rnw0000644000176200001440000003005414525744640015170 0ustar liggesusers%\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} %% -*- encoding: utf-8 -*- %\VignetteIndexEntry{xts FAQ} %\VignetteDepends{zoo} \documentclass{article} % \usepackage{Rd} \usepackage{Sweave} \usepackage{hyperref} \hypersetup{colorlinks,% citecolor=black,% linkcolor=blue,% urlcolor=blue,% } %%\encoding{UTF-8} %%\usepackage[UTF-8]{inputenc} % \newcommand{\q}[1]{\section*{#1}\addcontentsline{toc}{subsection}{#1}} \author{xts Deveopment Team% \footnote{Contact author: Joshua M. Ulrich \email{josh.m.ulrich@gmail.com}} \footnote{Thanks to Alberto Giannetti and Michael R. Weylandt for their many contributions.} } \title{\bf xts FAQ} %\Keywords{irregular time series, time index, daily data, weekly data, returns} %\Abstract{ % This is a collection of frequently asked questions (FAQ) about the % \pkg{xts} package together with their answers. %} \begin{document} \SweaveOpts{concordance=TRUE, engine=R, eps=FALSE} %\SweaveOpts{engine=R, eps=FALSE} <>= library("xts") Sys.setenv(TZ="GMT") @ \makeatletter \makeatother \maketitle \tableofcontents \q{What is \pkg{xts}?} % \pkg{xts} is an \pkg{R} package offering a number of functionalities to work on time-indexed data. \pkg{xts} extends \pkg{\pkg{zoo}}, another popular package for time-series analysis. % should point to the zoo FAQ here (or at some early point) \q{Why should I use \pkg{xts} rather than \pkg{zoo} or another time-series package?} % The main benefit of \pkg{xts} is its seamless compatibility with other packages using different time-series classes (\pkg{timeSeries}, \pkg{zoo}, ...). In addition, \pkg{xts} allows the user to add custom attributes to any object. See the main \pkg{xts} vignette for more information. \q{How do I install \pkg{xts}?} % \pkg{xts} depends on \pkg{zoo} and suggests some other packages. You should be able to install \pkg{xts} and all the other required components by simply calling \code{install.packages('pkg')} from the \pkg{R} prompt. \q{I have multiple .csv time-series files that I need to load in a single \pkg{xts} object. What is the most efficient way to import the files?} % If the files have the same format, load them with \code{read.zoo} and then call \code{rbind} to join the series together; finally, call \code{as.xts} on the result. Using a combination of \code{lapply} and \code{do.call} can accomplish this with very little code: <>= filenames <- c("a.csv", "b.csv", "c.csv") sample.xts <- as.xts(do.call("rbind", lapply(filenames, read.zoo))) @ \q{Why is \pkg{xts} implemented as a matrix rather than a data frame?} % \pkg{xts} uses a matrix rather than data.frame because: \begin{enumerate} \item \pkg{xts} is a subclass of \pkg{zoo}, and that's how \pkg{zoo} objects are structured; and \item matrix objects have much better performance than data.frames. \end{enumerate} \q{How can I simplify the syntax when referring to \pkg{xts} object column names?} % \code{with} allows you to use the colmn names while avoiding the full square brackets syntax. For example: <>= lm(sample.xts[, "Res"] ~ sample.xts[, "ThisVar"] + sample.xts[, "ThatVar"]) @ can be converted to <>= with(sample.xts, lm(Res ~ ThisVar + ThatVar)) @ \q{How can I replace the zeros in an \pkg{xts} object with the last non-zero value in the series?} % Convert the zeros to \code{NA} and then use \code{na.locf}: <<>>= sample.xts <- xts(c(1:3, 0, 0, 0), as.POSIXct("1970-01-01")+0:5) sample.xts[sample.xts==0] <- NA cbind(orig=sample.xts, locf=na.locf(sample.xts)) @ \q{How do I create an \pkg{xts} index with millisecond precision?} % Milliseconds in \pkg{xts} indexes are stored as decimal values. This example builds an index spaced by 100 milliseconds, starting at the current system time: <<>>= data(sample_matrix) sample.xts <- xts(1:10, seq(as.POSIXct("1970-01-01"), by=0.1, length=10)) @ \q{I have a millisecond-resolution index, but the milliseconds aren't displayed. What went wrong?} % Set the \code{digits.secs} option to some sub-second precision. Continuing from the previous example, if you are interested in milliseconds: <<>>= options(digits.secs=3) head(sample.xts) @ \q{I set \code{digits.sec=3}, but \pkg{R} doesn't show the values correctly.} % Sub-second values are stored with approximately microsecond precision. Setting the precision to only 3 decimal hides the full index value in microseconds and might be tricky to interpret depending how the machine rounds the millisecond (3rd) digit. Set the \code{digits.secs} option to a value higher than 3 or convert the date-time to numeric and use \code{print}'s \code{digits} argument, or \code{sprintf} to display the full value. For example: <<>>= dt <- as.POSIXct("2012-03-20 09:02:50.001") print(as.numeric(dt), digits=20) sprintf("%20.10f", dt) @ \q{I am using \code{apply} to run a custom function on my \pkg{xts} object. Why does the returned matrix have different dimensions than the original one?} % When working on rows, \code{apply} returns a transposed version of the original matrix. Simply call \code{t} on the returned matrix to restore the original dimensions: <>= sample.xts.2 <- xts(t(apply(sample.xts, 1, myfun)), index(sample.xts)) @ \q{I have an \pkg{xts} object with varying numbers of observations per day (e.g., one day might contain 10 observations, while another day contains 20 observations). How can I apply a function to all observations for each day?} % You can use \code{apply.daily}, or \code{period.apply} more generally: <<>>= sample.xts <- xts(1:50, seq(as.POSIXct("1970-01-01"), as.POSIXct("1970-01-03")-1, length=50)) apply.daily(sample.xts, colMeans) period.apply(sample.xts, endpoints(sample.xts, "days"), colMeans) period.apply(sample.xts, endpoints(sample.xts, "hours", 6), colMeans) @ \q{How can I process daily data for a specific time subset?} % First use time-of-day subsetting to extract the time range you want to work on (note the leading \code{"T"} and leading zeros are required for each time in the range: \code{"T06:00"}), then use \code{apply.daily} to apply your function to the subset: <>= apply.daily(sample.xts['T06:00/T17:00',], colMeans) @ \q{How can I analyze my irregular data in regular blocks, adding observations for each regular block if one doesn't exist in the origianl time-series object?} % Use \code{align.time} to round-up the indexes to the periods you are interested in, then call \code{period.apply} to apply your function. Finally, merge the result with an empty xts object that contains all the regular index values you want: <<>>= sample.xts <- xts(1:6, as.POSIXct(c("2009-09-22 07:43:30", "2009-10-01 03:50:30", "2009-10-01 08:45:00", "2009-10-01 09:48:15", "2009-11-11 10:30:30", "2009-11-11 11:12:45"))) # align index into regular (e.g. 3-hour) blocks aligned.xts <- align.time(sample.xts, n=60*60*3) # apply your function to each block count <- period.apply(aligned.xts, endpoints(aligned.xts, "hours", 3), length) # create an empty xts object with the desired regular index empty.xts <- xts(, seq(start(aligned.xts), end(aligned.xts), by="3 hours")) # merge the counts with the empty object head(out1 <- merge(empty.xts, count)) # or fill with zeros head(out2 <- merge(empty.xts, count, fill=0)) @ \q{Why do I get a \pkg{zoo} object when I call \code{transform} on my \pkg{xts} object?} % There's no \pkg{xts} method for \code{transform}, so the \pkg{zoo} method is dispatched. The \pkg{zoo} method explicitly creates a new \pkg{zoo} object. To convert the transformed object back to an \pkg{xts} object wrap the \code{transform} call in \code{as.xts}: <>= sample.xts <- as.xts(transform(sample.xts, ABC=1)) @ You might also have to reset the index timezone: <>= tzone(sample.xts) <- Sys.getenv("TZ") @ \q{Why can't I use the \code{\&} operator in \pkg{xts} objects when querying dates?} % \code{"2011-09-21"} is not a logical vector and cannot be coerced to a logical vector. See \code{?"\&"} for details. \pkg{xts}' ISO-8601 style subsetting is nice, but there's nothing we can do to change the behavior of \code{.Primitive("\&")}. You can do something like this though: <>= sample.xts[sample.xts$Symbol == "AAPL" & index(sample.xts) == as.POSIXct("2011-09-21"),] @ or: <>= sample.xts[sample.xts$Symbol == "AAPL"]['2011-09-21'] @ \q{How do I subset an \pkg{xts} object to only include weekdays (excluding Saturday and Sundays)?} % Use \code{.indexwday} to only include Mon-Fri days: <<>>= data(sample_matrix) sample.xts <- as.xts(sample_matrix) wday.xts <- sample.xts[.indexwday(sample.xts) %in% 1:5] head(wday.xts) @ \q{I need to quickly convert a data.frame that contains the time-stamps in one of the columns. Using \code{as.xts(Data)} returns an error. How do I build my \pkg{xts} object?} % The \code{as.xts} function assumes the date-time index is contained in the \code{rownames} of the object to be converted. If this is not the case, you need to use the \code{xts} constructor, which requires two arguments: a vector or a matrix carrying data and a vector of type \code{Date}, \code{POSIXct}, \code{chron}, \ldots, supplying the time index information. If you are certain the time-stamps are in a specific column, you can use: <<>>= Data <- data.frame(timestamp=as.Date("1970-01-01"), obs=21) sample.xts <- xts(Data[,-1], order.by=Data[,1]) @ If you aren't certain, you need to explicitly reference the column name that contains the time-stamps: <<>>= Data <- data.frame(obs=21, timestamp=as.Date("1970-01-01")) sample.xts <- xts(Data[,!grepl("timestamp",colnames(Data))], order.by=Data$timestamp) @ \q{I have two time-series with different frequency. I want to combine the data into a single \pkg{xts} object, but the times are not exactly aligned. I want to have one row in the result for each ten minute period, with the time index showing the beginning of the time period.} % \code{align.time} creates evenly spaced time-series from a set of indexes, \code{merge} ensure two time-series are combined in a single \pkg{xts} object with all original columns and indexes preserved. The new object has one entry for each timestamp from both series and missing values are replaced with \code{NA}. <>= x1 <- align.time(xts(Data1$obs, Data1$timestamp), n=600) x2 <- align.time(xts(Data2$obs, Data2$timestamp), n=600) merge(x1, x2) @ \q{Why do I get a warning when running the code below?} <<>>= data(sample_matrix) sample.xts <- as.xts(sample_matrix) sample.xts["2007-01"]$Close <- sample.xts["2007-01"]$Close + 1 #Warning message: #In NextMethod(.Generic) : # number of items to replace is not a multiple of replacement length @ % This code creates two calls to the subset-replacement function \code{xts:::`[<-.xts`}. The first call replaces the value of \code{Close} in a temporary copy of the first row of the object on the left-hand-side of the assignment, which works fine. The second call tries to replace the first \emph{element} of the object on the left-hand-side of the assignment with the modified temporary copy of the first row. This is the problem. For the command to work, there needs to be a comma in the first subset call on the left-hand-side: <>= sample.xts["2007-01",]$Close <- sample.xts["2007-01"]$Close + 1 @ This isn't encouraged, because the code isn't clear. Simply remember to subset by column first, then row, if you insist on making two calls to the subset-replacement function. A cleaner and faster solution is below. It's only one function call and it avoids the \code{\$} function (which is marginally slower on xts objects). <>= sample.xts["2007-01","Close"] <- sample.xts["2007-01","Close"] + 1 @ %%% What is the fastest way to subset an xts object? \end{document} xts/NEWS0000644000176200001440000011046414525745507011613 0ustar liggesusers################################################################################ Changed in xts 0.13.2: o Print a message when `period.apply()` is called with `FUN = mean` because it calculates the mean for each column, not all the data in the subset like it does for all other functions. The message says to use `FUN = colMeans` for current behavior and `FUN = function(x) mean(x)` to calculate the mean for all the data. This information is also included in the help files. The option `xts.message.period.apply.mean = FALSE` suppresses the message. (#124) o Fix error when `print.xts()` is called 'quote' or 'right' arguments. (#401) o Fix `addPolygon()` so it renders when `observation.based = TRUE`. (#403) o Print trailing zeros for index value with fractional seconds, so every index value has the same number of characters. (#404) o Add ability to log scale the y-axis in `plot.xts()`. (#103) o Actually change the underlying index values when 'tclass' is changed from a class with a timezone (e.g. POSIXct) to one without a timezone (e.g. Date). Add a warning when this happens, with a global option to always suppress the warning. (#311). o Significantly refactor the internals of `plot.xts()`. (#408) ################################################################################ Changed in xts 0.13.1: o Ignore attribute order in `all.equal()`. Attribute order shouldn't matter. That can be checked with `identical()`. o Only call `tzone()` and `tclass()` once in `check.TZ()`. Calling these functions multiple times throws multiple warnings for xts objects created before the tclass and tzone were attached to the index instead of the xts object. (#306) o Add instructions to update old objects. Old xts objects do not have tclass and tzone attributes on the index. Add a function to update the object attributes and add a note to the warning to show how to use it. (#306) o Return 'POSIXct' if object has no 'tclass'. An empty string is not a valid 'tclass', so it can cause an error. o Add notes on `plot.xts()` nomenclature and structure. Also add ASCII art to illustrate definitions and layout. (#103) o Remove 'tis' support. The implementation was not even a bare minimum, and it's not clear it even worked correctly. (#398) o Register missing S3 methods and update signatures. With R-devel (83995-ish), `R CMD check` notes these S3 methods are not registered. It also notes that the signatures for `as.POSIXct.tis()` and `str.replot_xts()` do not match the respective generics. It also thinks `time.frequency()` is a S3 method because `time()` is a generic. The function isn't exported, so renaming won't break any external code. Thanks to Kurt Hornik for the report. (#398) o Format each column individually before printing. The top/bottom rows could have a different number of decimal places and there are often multiple variying spaces between columns. For example: close volume ma bsi 2022-01-03 09:31:00 476.470 803961.000 NA 54191.000 2022-01-03 09:32:00 476.700 179476.000 NA 53444.791 2022-01-03 09:33:00 476.540 197919.000 NA -16334.994 ... 2023-03-16 14:52:00 394.6000 46728.0000 392.8636 28319.4691 2023-03-16 14:53:00 394.6500 64648.0000 392.8755 15137.6857 2023-03-16 14:54:00 394.6500 69900.0000 392.8873 -1167.9368 There are 4 spaces between the index and the 'close' column, 2 between 'close' and 'volume', 4 between 'volume' and 'ma', and 2 between 'ma' and 'bsi'. There should be a consistent number of spaces between the columns. Most other classes of objects print with 1 space between the columns. The top rows have 3 decimals and the bottom rows have 4. These should also be the same. (#321) o Only convert printed index values to character. Converting the entire index to character is time-consuming for xts objects with many observations. It can take more than a second to print an xts object with 1mm observations. o Make column names based on number of columns. The original code was a lot more complicated because it tried to account for truncating the number of printed columns. That functionality was removed because of how complicated it was. So now we can simply create printed column names from the number of columns. (#395) o Fix `xts()` for zero-row data.frame. The `xts()` constructor would create an object with a list for coredata when 'x' is a data.frame with no rows. It needs to convert 'x' to a matrix and throw an error if 'x' is a list. (#394) o Reduce instances when `dplyr::lag()` warning is shown. The warning was shown whenever it detected dplyr is installed, even if the user wasn't actively using dplyr. That caused an excessive amount of noise when other packages attached xts (e.g. quantmod). Thanks to Duncan Murdoch for the report and suggested fix! (#393) o Keep colname when only one non-time-based column. The subset `x[, -which.col]` would return a vector when the data frame has a time-based column and only one additional column. Do not drop dimensions, so 'x' will still be a data.frame in this case. (#391) o Treat NA the same as NULL for start or end values. NULL represents an undefined index value. NA represents an unknown or missing index value. xts does not allow NA as index values. Subsetting an xts or zoo object by NA returns a zero-length object. So a NA (unknown) index value is essentially the same as an undefined index value. (#383, #345) o Warn and remove NA when `periodicity()` called on date-time with NA. Otherwise the uninformative error below will be thrown. (#289) Error in try.xts(x, error = "'x' needs to be timeBased or xtsible") : 'x' needs to be timeBased or xtsible o Account for TZ when making names for `split.xts()`. `as.yearmon.POSIXct()` always sets `tz = "GMT"` when calling `as.POSIXlt()`, regardless of the xts' index tzone. That can cause the `as.yearmon()` results to be different days for GMT and the index's timezone. Use `format.POSIXct()` for "months" because it checks for a 'tzone' attribute before converting to POSIXlt and calling `format.POSIXlt()`. The conversion to POSIXlt is important because it checks and uses the 'tzone' attribute before considering the 'tz' argument. So it effectively ignores the `tz = "GMT"` setting in `as.yearmon()`. This is also the reason for calling `as.POSIXlt()` before calling `as.yearqtr()`. (#392) ################################################################################ Changed in xts 0.13.0: ### New Features o Added a xts method for `na.fill()` to significantly increase performance when 'fill' is a scalar. (#259) o `as.xts()` will look for a time-based column in a data.frame if it cannot create an index from the row names. (#381) o Change `print()` xts method to only show the first and last 'show.rows' rows if number of rows is > 'max.rows'. (#321) o Made `str()` output more descriptive for xts objects. It now differentiates between xts objects that are empty, zero-width, or zero-length, and defines each type of object. It also adds column names to the output. (#168, #378) o Add startup warning that `dplyr::lag()` breaks method dispatch, which means calls to `lag(my_xts)` won't work any more. o Added open-ended time of day subsetting ranges. This allows users to subset by time of day from the start/end of the day without providing the start/end times (00:00:00.000/23:59:59.999). For example: x["/T1800"] # between the start of the day and 5pm x["T0500/"] # between 5am and the end of the day Thanks to Chris Katsulis for the suggestion! (#243) o Updated `to.period()` to accept custom 'endpoints' via the 'period' argument. Now you can aggregate on something other than the times that 'endpoints()' supports. Thanks to Ethan B. Smith for the suggestion! (#302) ### Fixes o Fixed typo and expand `period.apply()` documentation. (#205) The original description has: * "the data from INDEX[k] to INDEX[k+1]" But that's not consistent with the code. It should be: * "the data from INDEX[k]+1 to INDEX[k+1]" o Calls to `merge.xts()` on zero-width objects now match `merge.zoo()`. Previously, `merge.xts()` would return empty xts objects if called on two or more zero-width xts objects. `merge.zoo()` would return a zero-width object with the correct index. (#227, #379) o Fixed `Ops.xts()` so it always returned an object with the same class as the first (left-hand side) argument. It previously returned an xts object even if the first argument was a subclass of xts. (#49) ### Other o Migrated unit tests from RUnit to tinytest. Thanks Mark van der Loo! o Updated the `endpoints()` documentation to make it clearer that the result is based on the UNIX epoch (midnight 1970, UTC). Thanks to GitHub user Eluvias for the suggestion! (#299) o Fixed `reclass()` to ensure it always adds index attributes from the 'match.to' argument. It was not copying `tclass`, `tzone`, or `tformat` from 'match.to' to the result object. (#43) o Removed an unnecessary check in `na.locf()` (which is not user-facing). Thanks to GitHub user @cgiachalis for the suggestion! (#307) o Updated C entry points so they're not able to accidentally be found via dynamic lookup (i.e. `.Call("foo", ...)`). This makes each call to the C code a few microseconds faster, which is nice. (#260) o Made `merge.xts()` results consistent with `merge.zoo()` for zero-length xts objects with columns. The result of `merge.xts()` did not include the columns of any objects that had one or more columns, but zero rows. A join should include all the columns of the joined objects, regardless of the number of rows in the object. This is consistent with `merge.zoo()`. Thanks to Ethan B. Smith for the report and testing! (#222) ################################################################################ Changed in xts 0.12.2: o `Ops.xts()` no longer changes column names (via `make.names()`) when the two objects do not have identical indexes. This makes it consistent with `Ops.zoo()`. (#114) o Subsetting a zero-length xts object now returns an object with the same storage type as the input. It previously always returned a 'logical' xts object. (#376) o `tclass()` and `tzone()` now return the correct values for zero-length xts objects, instead of the defaults in the `.xts()` constructor. Thanks to Andre Mikulec for the report and suggested patch! (#255) o `first()` and `last()` now return a zero-length xts object when `n = 0`. They previously returned the entire object. This is consistent with the default `head()` and `tail()` functions, and data.table's `first()` and `last()` functions. Thanks to Ethan B. Smith for the report and patch! (#350) o `plot.xts()` now has a `yaxis.ticks` argument to control the number of y-axis grid lines, instead of always drawing 5 grid lines. Thanks to Fredrik Wartenberg for the feature request and patch! (#374) o Subsetting a zero-width xts now returns an object with the same class, tclass, tzone, and xtsAttributes as the input. Thanks to @shikokuchuo for the report! (#359) o `endpoints()` now always returns last observation. Thanks to GitHub user Eluvias for the report. (#300) o Ensure `endpoints()` errors for every 'on' value when `k < 1`. It was not throwing an error for `k < 1` for `on` of "years", "quarters", or "months". Thanks to Eluvias for the report. (#301) o Fix `window()` for yearmon and yearqtr indexes. In xts < 0.11-0, `window.zoo()` was dispatched when `window()` was called on a xts object because there was no `window.xts()` method. `window.zoo()` supports additional types of values for the `start` argument, and possibly other features. So this fixes a breaking change in xts >= 0.11-0. Thanks to @annaymj for the report. (#312) o Clarify whether `axTicksByTime()` returns index timestamps or locations (e.g. 1, 2, 3). Thanks to @ggrothendieck for the suggestion and feedback. (#354) o Fix merge on complex types when 'fill' is needed. `merge()` would throw an error because it treated 'fill' as double instead of complex. Thanks to @ggrothendieck for the report. (#346) o Add a message to tell the user how to disable 'xts_check_TZ' warning. Thanks to Jerzy Pawlowski for the nudge. (#113) o Update `rbind()` to handle xts objects without dim attribute. `rbind()` threw an obscure error if one of the xts objects does not have a dim attribute. We can handle this case even though all xts objects should always have a dim attribute. (#361) o `split.xts()` now always return a named list, which makes it consistent with `split.zoo()`. Thanks to Gabor Grothendieck for the report. (#357) o xts objects with a zero-length POSIXct index now return a zero-length POSIXct vector instead of a zero-length integer vector. Thanks to Jasper Schelfhout for the report and PR! (#363, #364) o Add suffixes to output of `merge.xts()`. The suffixes are consistent with `merge.default()` and not `merge.zoo()`, because `merge.zoo()` automatically uses "." as a separator between column names, but the default method doesn't. Thanks to Pierre Lamarche for the nudge. Better late than never? (#38, #371) Changes to plotting functionality -------------------------------------------------------------------------------- o You can now omit the data time range from the upper-right portion of a plot by setting `main.timespan = FALSE`. (#247) o Fix `addEventLines()` when plotted objects have a 'yearmon' index. The ISO-8601 range string was not created correctly. Thanks to @paessens for the report. (#353) o Make 'ylim' robust against numerical precision issues by replacing `==` with `all.equal()`. Thanks to @bollard for the report, PR, and a ton of help debugging intermediate solutions! (#368) o Series added to a panel now extend the panel's y-axis. Previously the y-axis limits were based on the first series' values and not updated when new series were added. So values of the new series did not appear on the plot if they were outside of the original series' min/max. Thanks to Vitalie Spinu for the report and help debugging and testing! (#360) o All series added to any panel of a plot now update the x-axis of all panels. So the entire plot's x-axis will include every series' time index values within the original plot's time range. This behavior is consistent with `chart_Series()`. Thanks to Vitalie Spinu for the report and help debugging and testing! (#360, #216) o All y-values are now plotted for series that have duplicate index values, but different data values. Thanks to Vitalie Spinu for the report and help debugging and testing! (#360) o Adding a series can now extend the x-axis before/after the plot's existing time index range, so all of the new series' time index values are included in the plot. This is FALSE by default to maintain backward compatibility. Thanks to Vitalie Spinu for the report and help debugging and testing! (#360) ################################################################################ Changed in xts 0.12.1: o Various function could change the tclass of xts objects. This would happen in calls to reclass(), period.apply(), and for logical operations on POSIXct indexes. Thanks to Tom Andrews for the report and testing, and to Panagiotis Cheilaris for contributing test cases (#322, #323). o plot.xts() now supports y-axis labels via 'ylab'. Thanks to Jasen Mackie for the suggestion and PR (#333, #334). o The API header has been updated to fix the signatures of do_merge_xts() and is_xts, which did not return a SEXP as required of functions callable by .Call(). Thanks to Tomas Kalibera for the report (#317), and Dirk Eddelbuettel for the PR (#337). This is a breaking change, but is required to avoid the potential for a segfault. o Michael Chirico added an internal isUTC() function to recognize many UTC- equivalent time zones (#319). o first() now operates correctly on non-xts objects when 'n = -1'. Previously it would always return the last two values. Thanks to GitHub user vxg20 for the report (#325). o The .xts() constructor would create an xts object with row names if 'x' had row names. This shouldn't happen, because xts objects do not have or support row names (#298). o Claymore Marshall added many examples of time-of-day subsetting to ?subset.xts. He also fixed a bug in time-of-day subsetting where subsetting by hour only returned wrong results (#304, #326, #328). Changed in xts 0.12-0: o All the index-attributes have been removed from the xts object and are now only attached to the index itself (#245). We took great care to maintain backward compatibility, and throw warnings when deprecated functions are called and when index-attributes are found on the xts object. But there still may be some breaking changes lurking in edge cases. o @SamoPP found one edge case (#297) where an error was thrown when index() was called on an xts object with an index that had no tclass attribute. o ...which led Joshua to find that the index setting functions did not always copy index attributes (#305). o Several binary operations (e.g. +, -, !=, <, etc.) on variations of uncommon xts objects with other xts, matrix, or vector objects, could result in malformed xts objects (#295). Some examples of the types of uncommon xts objects: no dim attribute, zero-width, zero-length. o Calling as.matrix() on an xts object without a dim attribute no longer throws an error (#294). o merge.xts() now honors check.names = FALSE (#293). o The possible values for major.ticks, minor.ticks, and grid.ticks.on in the Details section of ?plot.xts have been corrected. Thanks to Harvey Smith (@harvey131) for the report and patch (#291). o as.zoo.xts() is now only registered for zoo versions prior to 1.8-5. Methods to convert an object to another class should reside in the package that implements the target class. Thanks to Kurt Hornik for the report (#287). o .parseISO8601() no longer has a potential length-1 logical error. Thanks to Kurt Hornik for the report (#280). o endpoints() now honors k > 0 when on = "quarters". Thanks to @alkment for the report (#279). o Performance for the period.XYZ() functions (sum, prod, min, max) is much faster (#278). Thanks to Chris Katsulis for the report, and Harvey Smith (@harvey131) for several examples. o merge.xts() now creates shorter column names when passed unnamed objects. This is now consistent with zoo (#248). o Time-of-day performance is ~200x faster, thanks to StackOverflow user3226167 (#193). Changed in xts 0.11-2: o The to.period() family of functions now use the index timezone when converting intraday index values to daily values (or lower frequency). Thanks to Garrett See and Gabor Grothendieck for the reports (#53, #277). o Make column names for merge() results with unnamed objects shorter and more like zoo (#248). This also makes na.fill() much faster (#259). BREAKING: This may break existing code for integer unnamed objects. o Fix subset when 'index(x)' and 'i' contain duplicates. Thanks to Stack Overflow user 'scs' (https://stackoverflow.com/users/4024268/scs) for the report, and Philippe Verspeelt for debugging (#275). o Fix if-statement in xts constructor that may use a logical with length > 1. Thanks to @HughParsonage for the report and PR (#270, #272). o Register shift.time.xts() method. Thanks to Philippe Verspeelt for the report and PR (#268, #273). o Conditionally register S3 methods for as.timeSeries.xts() and as.fts.xts() when their respective packages are available (as requested by CRAN). Note that this means these two functions are no longer exported. This may break some existing code that calls the methods directly, though 'best practice' is to let method dispatch determine which method to invoke. Changed in xts 0.11-1: o Fix regression in .xts() that caused 'tclass' argument/attribute to be incorrectly set to POSIXct regardless of user-provided value. Thanks to @Eluvias for the report and Tom Andrews for the PR (#249, #250). o Fix performance regression when xts object is subset by a date-time vector. Thanks to Tom Andrews for the report, and the PR to fix the bug in my patch (#251, #263, #264). o Restore behavior from 0.10-2 so subsetting an empty xts object by a date- time vector returns an empty xts object instead of throwing an error. Thanks to @alkment for the report (#252). o Add ability for merge.xts() to handle multiple character or complex xts objects. Thanks to Ken Williams for the report (#44). o Add ability to use "quarters" to specify tick/grid mark locations on plots. This ran but produced an incorrect result in 0.10-2 and threw an error in 0.11-0. Thanks to Marc Weibel for the report (#256). o Fix illegal read reported by valgrind. Thanks to Tom Andrews for the report and PR (#236, #264). Changed in xts 0.11-0: o Fix make.index.unique() to always return a unique and sorted index. Thanks to Chris Katsulis for the report and example (#241). o Add window.xts() method and completely refactor the internal binary search function it depends on. Thanks to Corwin Joy for the PR, tests, review, and patience (#100, #240). o Better axis tick mark locations for plots. Thanks to Dirk Eddelbuettel for the report (#246). Also incorporate axTicksByTime2() into axTicksByTime() to reduce code duplication from the migration of quantmod::chart_Series() to xts::plot.xts() (#74). o Add details to plot.xts() parameters that are periodicity, now that RStudio has argument completion. Thanks to Evelyn Mitchell for the PR (#154). o periodicity() now warns instead of errors if the xts object contains less than 2 observations (#230). o first() and last() now keep dims when they would otherwise be dropped by a regular row subset. This is consistent with head() and tail(). Thanks to Davis Vaughan for the report (#226). o Fix subset when ISO8601 string is outside the valid range, so it returns no data instead of all rows (#96). o Avoid partial name matches from parse.side() (inside .parseISO8601()) results that are passed to firstof() and lastof(). Thanks to @gp2x for the report and the patch (#231). o na.locf.xts() now loops over columns of multivariate objects in C code, instead of in R. This should improve speed and memory performance. Thanks to Chris Katsulis and Tom Andrews for their reports and patches (#232, #233, #234, #235, #237). o Change plot.xts() default 'pch = 0' (rectangles) to 'pch = 1' (circles) so it looks more like base and zoo plots (#203). Changed in xts 0.10-2: o na.locf.xts() and na.omit.xts() now support character xts objects. Thanks to Ken Williams and Samo Pahor for the reports (#42). o na.locf.xts() now honors 'x' and 'xout' arguments by dispatching to the next method (#215). Thanks to Morten Grum for the report. o coredata.xts() now functions the same as coredata.zoo() on zero-length objects, and only removes xts-related attributes (#223). Thanks to Vincent Guyader for the report. o plot.xts() no longer ignores 'col.up' and 'col.dn' when 'type="h"' (#224). Thanks to Charlie Friedemann for the report. This was inadvertently broken as part of the fix for #210. Changed in xts 0.10-1: o 'ylim' values passed to 'addSeries' and 'addPolygon' via '...' are now captured and honored (#220). o 'addPolygon' now checks for ylim of zeros, as 'addSeries' does (#164). o The 'base::as.Date.numeric' method is no longer over-ridden. The exported, but not registered, method in zoo should prevent any change in behavior. o Series added to an existing plot are now given the same index values as the main panel (#216). There still may be some weird behavior if the new data does not have observations within the timespan of the main panel data, but no observations on the same timestamps. o Existing 'par' values are now captured and reset before returning from plotting functions (#217). o User-defined 'col' values are now honored when 'type="h"' (#210). o Values passed to plotting functions are now copied from the calling environment. This enables plotting arguments to be objects passed through multiple layers of function calls. o indexFormat is now generic, consistent with indexFormat<- (#188). o Calling as.matrix() on a zero-width xts object now behaves consistently with zoo, and no longer throws an error (#130). o Fix weird result in merge.xts() when 'fill' argument is NULL or a zero- length vector (#261). o Fixed bug in endpoints() due to sub-second representation error via using integer division (%/%) with non- integer arguments (#202). o endpoints() gained sub-second accuracy on Windows (#202). o plot.xts() no longer errors when called on an object containing a constant value. It chooses ylim values +/-20% from the series value (#156). o plot.xts() now places y-axis labels in the same location on the plot, regardless of data periodicity (#85). o rbind.xts() now throws an error if passed an xts object with different number of observations in the index and data (e.g., zero-width) (#98). Changed in xts 0.10-0: Major changes include: o A new plot.xts() that is incompatible with earlier versions of plot.xts(). o Moved development from R-Forge to GitHub. o New xts FAQ. Other, less disruptive changes include: o merge.xts() now throws an error if the index contains non-finite values (#174). o Constructors xts() and .xts() now ensure order.by and index arguments do not contain non-finite values. Many xts functions, most notably merge.xts(), expect all index values to be finite. Missing index values usually indicate an error, and always occurred at the end of the index (#173, #194, #199). o Fixed bug in endpoints() when called on sparse data that have the same month and day, but different years (#169). o Fixed bug in [.xts did not do the same checks on logical xts objects as it does for all other data types (#163). o Fixed bug that caused split.xts() to error if 'f' is a character vector with more than 1 element (#134). o Fixed bug that crashed R if 'k' argument to lag.xts() was not an integer and would be NA when coerced to integer (#152). o period.apply() now checks to ensure the object's index is unique and sorted, and sets INDEX <- sort(unique(INDEX)) if it is not. It also ensures INDEX starts with 0 and ends with NROW(x) (#171). o All references to the 'its' package have been removed, since it is now archived on CRAN at the request of its maintainer. o Fixed bug that crashed R when merge.xts() was called on an empty xts object and more than one non-xts object (#157). o Fixed bug that did not set the index's tzone attribute to UTC when index<-.xts or indexClass<- were called and 'value' did not have a tzone attribute (#148). o Fixed a bug in endpoints() that caused incorrect results if the index was less than the epoch (#144). o Fixed a bug that caused diff.xts() on a logical xts object to return an object with a POSIXct index. o index.xts() works even if the package containing the class for the index is not attached (it needs to be loaded, however). o [.xts now returns NA if a one-column xts object is subsect by NA, instead of throwing an uninformative error (#97). o Fixed bugs that would crash R when [.xts was called a certain way and 'j' contained NA values (#97, #181). o Fixed a bug in endpoints() where 1 second would be subtracted for any date in the year 1969. The subtraction is only supposed to occur on 1969-12-31 23:59:59.9... to work around behavior in strptime(). o timeBasedSeq() now honors hour/min/sec 'BY' values (#91). o [.xts now throws an error if 'j' is character and not one of the column names. This is consistent with [.zoo and [.matrix (#48). o timeBasedSeq() now works correctly when resolution is "days" the sequence includes a daylight saving time change (#67). o Explicitly set indexTZ="UTC" for all index classes that do not have a TZ (#66). indexTZ="GMT" is also allowed. o Fixed as.xts() when called on an 'mts' object (#64). o Moved development from R-Forge to GitHub. o Fixed bug in to.period() that errored when name=NULL (#5937). o Fixed bug in .index* functions that did not account for timezones (#5891). o Fixed bug that allowed index<-.xts to produce an unsorted index (#5893). o Fixed bug so subsetting a zero-width xts object with a zero-length 'i' vector no longer returns an object with column names (#5885). o Updated [.xts to handle 'i' containing multiple zeros (e.g. subsetting by a "logical" column of an integer xts object). o endpoints() now errors if k < 0. Changed in xts 0.9-7: o Fixed bug that caused logical operators on xts objects to drop the 'tzone' attribute (#2750). o Fixed bug that ignored 'which.i' argument to [.xts on zero-width xts objects (#2753). o Fixed bug where xts() does not sort 'order.by' if x is missing (#4775). Changed in xts 0.9-6: o Fixed bug where setting dimnames to NULL would break as.xts() (#4794). o Added checks to period.sum/prod/min/max to ensure INDEX is in [0,nrow(x)]. o Fixed missing argument to na_locf() in the C/C++ xtsAPI (Dirk Eddelbuettel). Changed in xts 0.9-5: o Increased zoo dependency version to 1.7-10 for changes in C code. o Fixed several minor issues in the C/C++ xtsAPI (Dirk Eddelbuettel). Changed in xts 0.9-4: o Fixed bug where the index was missing the 'tzone' attribute. o Fixed to.period() bug when 'indexAt' is "firstof" or "lastof". (bug #2691, patch #2710, thanks to Garrett See) o Fixed subsetting bug on zero-width xts objects that returned NA data and an NA index (#2669). o xts' merge() method now has 'drop' and 'check.names' arguments to match the zoo merge() method. o 'index<-' now correctly handles UTC Date objects when resetting index values. '.index<-' behaved correctly. o xts' rollapply() method now handles the 'fill' argument. o Added several functions to the C/C++ API: - make_index_unique - make_unique - endpoints - do_merge_xts - na_omit_xts - na_locf o Fixed xts' rollapply() method when input has one column, but function output has more than one column. Changed in xts 0.9-3: o No user-visible changes. Changed in xts 0.9-2: o Added C/C++ xtsAPI (Dirk Eddelbuettel) o Added tzone() and tclass() functions as aliases to indexTZ() and indexClass(), respectively. Eventually will Deprecate/Defunct the former. Changed in xts 0.9-1: o xts() now ignores timezone arguments when order.by is Date class, with a warning. Changed in xts 0.8-8: o Modified str() output to make use of proper ISO-8601 range formating o Fixed bug in reclass() when 'tzone' of object is different than system TZ. o Fixed bug in xts() that dropped dims when 'x' is a 1-column matrix or data.frame. o [.xts no longer warns if 'i' is zero-length. o to.period() now checks that 'x' is not zero-length/width. o Fixed edge case in Ops.xts where two objects with no common index create an invalid 'xts' object with no index. o to.monthly() and to.quarterly() now default to drop.time=TRUE. o Internal .drop.time() now changes the index class to Date. This affects the to.period() family of functions. o Restore Date index/tclass conversion to POSIXct with a UTC timezone via integer division instead of double-precision division. Changed in xts 0.8-6: o Revert Date index/tclass conversion to POSIXct with a UTC timezone to previous behavior as in 0.8-2. Changed in xts 0.8-5: o A Date index/tclass is now internally converted to POSIXct with a UTC timezone ensure proper conversion regardless of user TZ settings. o tclass is now an argument to .xts() o Fix endpoints() properly handles millisecond time stamps (and microsecond on not Windows). o Subsetting zero-width xts objects now behaves like zoo, with NA values returned for valid row requests. Changed in xts 0.8-2: o Fixed bug in lag() and diff() for character coredata. o Fixed subsetting bug that returned a contiguous chunk of data even when a non-contiguous 'i' was provided. o Fixed bug that ignored FinCenter/TZ for timeDate index o period.apply() now only sets colnames if the number of columns in the input and output are equal. o Fixed periodicity() when scale = "yearly" o Fixed [.xts when row-subsetting via a POSIXct vector, which returned an object full of NA. o Added '...' to axis() call inside of plot.xts() to allow for 'cex.axis' and 'cex.lab' to be passed in. o Fixed axes=FALSE issue in plot.xts(). o Dependency now on 1.7-0 or better of zoo (R-forge at present) This build now links to C code moved from xts to zoo. At present this is only for zoo_lag (used in lag and lagts) o Added 'drop' and 'fromLast' arguments to make.index.unique(). o Added adj.time() and shift.time() o Fixed na.locf() bug that would fill trailing NA larger than 'maxgap' observations (#1319) o Updated indexFormat() documentation and add an example Changed in xts 0.8-0: o Fix print formatting (#1080) o Fix bug related to na.locf() and zero-width objects (#1079) o Add .RECLASS = FALSE after '...' for as.xts.*() methods. This makes all as.xts.*() methods one-way (i.e. not reclass-able). Objects converted to xts via try.xts() can still be converted back to their original class via relcass(). o Fix bug that caused colnames to be dropped if object is subset by time that is not in the index. Changes in xts 0.7-5: o try.xts and reclass now are more efficient on xts objects, no longer appending a .RECLASS attribute. This penalty (copying) is shifted to classes that are internally converted to xts. Changes in xts 0.7-4: o internal attributes of index are now maintaining timezone (tzone), time class (tclass) information. o `[.xts` method is now using new C code. This may revert back as character-based objects are not supported. Changed for future code refactoring into zoo, as well as performance gains on integer, double and logical values. Also added in checks for NAs. drop=TRUE now works correctly in all known applications. o (cbind)merge.xts and rbind.xts now copy index attributes to handle internal changes to index characteristics (in C code) o indexTZ.Rd updated to provide information regarding internal changes. Also indexTZ<- is now exported to facilitate timezone changing of xts objects. Changes in xts 0.7-1: o subsecond ISO8601 subsetting on dates before 1970 (epoch) is disabled. This is due to a bug in the R implementation of POSIX handling of fractional seconds pre-1970. 10 microsecond granularity is still functional for all other times. Thanks to Andreas Noack Jensen for the early bug report. o new 'tzone' arg in xts constructor and 'tz' in .parseISO8601 allows for future support of non-system TZ dependent indexing o internal index attribute (numeric) now can have attributes set (tzone is currently the only one used in xts). These should remain during all xts operations. Still experimental. o naCheck has been exposed at the C level for use in packages "LinkingTo: xts". See ?xtsAPI for more details. Changes in xts 0.7-0: o A new NEWS file. o print.xts now passes ... o endpoints speedup and bug fix (thanks Ismail Onur Filiz) o na.omit bug on logical and NaN fixes (thanks Fabrizio Pollastri and Koert Kuipers) o fromLast=FALSE for na.locf.xts. Matching to zoo. (thanks to Sandor Benczik) o LGLSXP support in leadingNA (R fun naCheck) o fixed logical and NA 'j' subsetting. Thanks Koert Kuipers. o as.xts and as.timeSeries fixes for timeSeries changes o merge and subset now support dimensionless xts (non-standard). merge segfault fixed when merging all 3 or more zero-width xts objects and only zero-width objects. Thanks to Koert Kuipers for the report. o added which.i to [.xts to return i values found via ISO8601 subset string o new lines.xts and plot.xts, similar to methods in zoo o lastof now has sec to 10 microsecond precision, and subsec arg to append to secs. o xts() further consistency in NROW/index check o align.time error checks for positive n= values (thanks Brian Peterson) o toPeriod updates in C, almost exported. ~600-1200x faster o new lag_xts in C. Increased speed and index flexibility. o endpoints 'days' bug fix o .makeISO8601 function to create ISO8601 compliant string from xts objects xts/R/0000755000176200001440000000000014552546765011314 5ustar liggesusersxts/R/POSIX.R0000644000176200001440000000153714522244662012333 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.xts.POSIXt <- function(x, ...) { xts(NULL, order.by=x) } xts/R/as.environment.xts.R0000644000176200001440000000164314522244662015212 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.environment.xts <- function(x) { e <- new.env() lapply(1:NCOL(x), function(.) assign(colnames(x)[.], x[,.],envir=e)) e } xts/R/parse8601.R0000644000176200001440000001330614525744640013063 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # This function corresponds to the ISO 8601 standard # for specifying dates and times as described in # the ISO 8601:2004e standard. # # See: # http://en.wikipedia.org/wiki/ISO_8601 # http://www.iso.org/iso/support/faqs/faqs_widely_used_standards/widely_used_standards_other/date_and_time_format.htm # # This implementation is currently restricted # to interval based parsing, with basic or # extended formats, and duration strings. # Currently the duration must be in basic format # e.g. PnnYnnMnnDTnnHnnMnnS # # The return value is a list of start and # end times, in POSIXt space. # # Copyright 2009. Jeffrey A. Ryan. All rights reserved. # This is licensed under the GPL version 2 or later .makeISO8601 <- function(x) { paste(start(x), end(x), sep = "/") } .parseISO8601 <- function(x, start, end, tz="") { # x: character vector of length 1 in ISO8601:2004(e) format # start: optional earliest time # end: optional latest time # tz: optional tzone to create with as_numeric <- function(.x) { # simple helper function if(gsub(" ","",.x)=="") NULL else as.numeric(.x) } x <- gsub("NOW",format(Sys.time(),"%Y%m%dT%H%M%S"),x) x <- gsub("TODAY",format(Sys.Date(),"%Y%m%d"),x) if(identical(grep("/|(--)|(::)", x), integer(0))) { x <- paste(x,x,sep="/") } intervals <- unlist(strsplit(x, "/|(--)|(::)")) # e.g. "/2009": "" "xxx" end of defined, needs context # e.g. "2009/": "xxx" start of defined, needs context # check for duration specification DURATION <- "" if(length(intervals)==2L) { if(substr(intervals[1],0,1)=="P") { # duration on LHS DURATION <- intervals[1] DURATION_LHS <- TRUE intervals[1] <- "" } if(substr(intervals[2],0,1)=="P") { # duration on RHS DURATION <- intervals[2] DURATION_LHS <- FALSE intervals <- intervals[1] } # leave alone if no duration } parse.side <- function(x, startof) { if( is.na(x) || !nzchar(x)) return(c(NULL)) basic <- gsub(":|-", "", x, perl=TRUE) #, extended=TRUE) date.time <- unlist(strsplit(basic, " |T")) # dates date <- date.time[1] if(!missing(startof) && nchar(basic)==2L) { startof <- gsub(":|-", "", startof, perl=TRUE) #, extended=TRUE) if(nchar(startof) - nchar(date) >= 4) { # FIXME 200901/2009 needs to work, fix is ex-post now # pad to last place of startof # with startof values sstartof <- substr(startof,0,nchar(startof)-nchar(date)) date <- paste(sstartof,date,sep="") } } date <- sprintf("%-8s", date) YYYY <- substr(date,0,4) MM <- substr(date,5,6) DD <- substr(date,7,8) # times time <- date.time[2] if( !is.na(time)) { time <- sprintf("%-6s", time) H <- substr(time,0,2) M <- substr(time,3,4) S <- substr(time,5,10000L) } else H<-M<-S<-"" # return as list c(as.list(c( year=as_numeric(YYYY), month=as_numeric(MM), day=as_numeric(DD), hour=as_numeric(H), min=as_numeric(M), sec=as_numeric(S) ) ),tz=tz) } s <- e <- NA if(nzchar(intervals[1])) # LHS s <- as.POSIXlt(do.call(firstof, parse.side(intervals[1]))) if(length(intervals) == 2L) { # RHS e <- as.POSIXlt(do.call(lastof, parse.side(intervals[2],intervals[1]))) if(is.na(e)) e <- as.POSIXlt(do.call(lastof, parse.side(intervals[2]))) } if(is.na(s) && is.na(e) && !nzchar(DURATION) && intervals[1L] != "") { warning("cannot determine first and last time from ", x) return(list(first.time=NA_real_,last.time=NA_real_)) } if(!missing(start)) { start <- as.numeric(start) #s <- as.POSIXlt(structure(max(start, as.numeric(s), na.rm=TRUE), # class=c("POSIXct","POSIXt"),tz=tz)) s <- as.POSIXlt(.POSIXct(max(start, as.numeric(s), na.rm=TRUE),tz=tz)) } if(!missing(end)) { end <- as.numeric(end) #e <- as.POSIXlt(structure(min(end, as.numeric(e), na.rm=TRUE), # class=c("POSIXct","POSIXt"),tz=tz)) e <- as.POSIXlt(.POSIXct(min(end, as.numeric(e), na.rm=TRUE),tz=tz)) } if(nzchar(DURATION)) { parse_duration <- function(P) { # TODO: # strip leading P from string # convert second M (min) to 'm' IFF following a T # remove/ignore T # convert extended format (PYYYYMMDD) to basic format (PnnYnnMnnD) P <- gsub("P","",P) P <- gsub("T(.*)M","\\1m",P) n <- unlist(strsplit(P, "[[:alpha:]]")) d <- unlist(strsplit(gsub("[[:digit:]]", "", P),"")) dur.vec <- list(as.numeric(n),unname(c(Y=6,M=5,D=4,H=3,m=2,S=1)[d])) init.vec <- rep(0, 9) init.vec[dur.vec[[2]]] <- dur.vec[[1]] init.vec } if(DURATION_LHS) { s <- as.POSIXct(structure(as.list(mapply(`-`,e,parse_duration(DURATION))), class=c("POSIXlt","POSIXt"), tzone=attr(e,"tzone"))) } else { e <- as.POSIXct(structure(as.list(mapply(`+`,s,parse_duration(DURATION))), class=c("POSIXlt","POSIXt"), tzone=attr(e,"tzone"))) } } list(first.time=as.POSIXct(s),last.time=as.POSIXct(e)) } xts/R/print.R0000644000176200001440000000760214525744640012570 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . print.xts <- function(x, fmt, ..., show.rows = 10, max.rows = 100) { check.TZ(x) nr <- NROW(x) nc <- NCOL(x) dots <- list(...) if (missing(max.rows)) { # the user didn't specify a value; use the global option value if it's # set; if it's not set, use the default value max.rows <- getOption("xts.print.max.rows", max.rows) } # 'max' in print.default() takes precedence over 'show.rows' if (hasArg("max")) { # 'max' is the number of *elements* (not rows) to print if (nr < 1) { show.rows <- 0 } else { # convert 'max' to 'show.rows' if (!is.null(dots$max)) { show.rows <- trunc(dots$max / nc) } } } else if (missing(show.rows)) { # the user didn't specify a value; use the global option value if it's # set; if it's not set, use the default value show.rows <- getOption("xts.print.show.rows", show.rows) } if (missing(fmt)) { fmt <- tformat(x) } if (is.null(fmt)) { fmt <- TRUE } if (!hasArg("quote")) { dots$quote <- FALSE } if (!hasArg("right")) { dots$right <- TRUE } if (nr > max.rows && nr > 2 * show.rows) { # 'show.rows' can't be more than 2*nrow(x) or observations will be printed # twice, once before the "..." and once after. seq.row <- seq_len(show.rows) seq.col <- seq_len(nc) seq.n <- (nr - show.rows + 1):nr # format all the index values that will be printed, # so every row will have the same number of characters index <- format(index(x)[c(seq.row, seq.n)]) # combine the index values with the '...' separator index <- c(index[seq.row], "...", index[-c(seq.row, tail(seq.row, 1))]) # as.matrix() to ensure we have dims # unclass() avoids as.matrix() method dispatch m <- as.matrix(unclass(x)) # convert to data.frame to format each column individually m <- data.frame(m[c(seq.row, seq.n), seq.col, drop = FALSE]) m[] <- lapply(m, format) m <- as.matrix(m) # insert blank row between top and bottom rows y <- rbind(utils::head(m, show.rows), rep("", nc), utils::tail(m, show.rows)) rownames(y) <- format(index, justify = "right") colnames(y) <- colnames(m[, seq.col, drop = FALSE]) } else { y <- coredata(x, fmt) } if (length(y) == 0) { if (!is.null(dim(x))) { p <- structure(vector(storage.mode(y)), dim = dim(x), dimnames = list(format(index(x)), colnames(x))) print(p) } else { cat('Data:\n') print(vector(storage.mode(y))) cat('\n') cat('Index:\n') index <- index(x) if (length(index) == 0) { print(index) } else { print(str(index)) } } } else { # ensure 'y' has dims and row names if (is.null(dim(y))) { y_names <- as.character(index(x)) y <- matrix(y, nrow = length(y), dimnames = list(y_names, NULL)) } # Create column names as column indexes. if (is.null(colnames(y))) { colnames(y) <- paste0("[,", seq_len(ncol(y)), "]") } do.call("print", c(list(y), dots)) } invisible(x) } xts/R/period.R0000644000176200001440000000567214522244665012722 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # optimized periodic apply functions # `is.timeBased` <- `timeBased` <- function(x) { time.classes <- c("Date", "POSIXt", "chron", "dates", "times", "timeDate", "yearmon", "yearqtr", "xtime") inherits(x, time.classes) } make.timeBased <- function(x, class='POSIXct', ...) { do.call(class, list(x,...)) } `period.sum` <- function(x,INDEX) { if(NCOL(x) > 1) stop("single column data only") if(min(INDEX) < 0 || max(INDEX) > NROW(x)) stop("INDEX must be >= 0 and <= nrow(x)") ep <- as.integer(INDEX) if(ep[1L] != 0L) ep <- c(0L,ep) if(ep[length(ep)] != NROW(x)) ep <- c(ep,NROW(x)) xx <- as.double(x) xa <- .Call(C_xts_period_sum, xx, ep) if(timeBased(index(x))) { tz <- xts(xa, index(x)[ep[-1]]) } else { tz <- zoo(xa, index(x)[ep[-1]]) } tz } `period.prod` <- function(x,INDEX) { if(NCOL(x) > 1) stop("single column data only") if(min(INDEX) < 0 || max(INDEX) > NROW(x)) stop("INDEX must be >= 0 and <= nrow(x)") ep <- as.integer(INDEX) if(ep[1] != 0L) ep <- c(0L,ep) if(ep[length(ep)] != NROW(x)) ep <- c(ep,NROW(x)) xx <- as.double(x) xa <- .Call(C_xts_period_prod, xx, ep) if(timeBased(index(x))) { tz <- xts(xa, index(x)[ep[-1]]) } else { tz <- zoo(xa, index(x)[ep[-1]]) } tz } `period.max` <- function(x,INDEX) { if(NCOL(x) > 1) stop("single column data only") if(min(INDEX) < 0 || max(INDEX) > NROW(x)) stop("INDEX must be >= 0 and <= nrow(x)") ep <- as.integer(INDEX) if(ep[1] != 0L) ep <- c(0L,ep) if(ep[length(ep)] != NROW(x)) ep <- c(ep,NROW(x)) xx <- as.double(x) xa <- .Call(C_xts_period_max, xx, ep) if(timeBased(index(x))) { tz <- xts(xa, index(x)[ep[-1]]) } else { tz <- zoo(xa, index(x)[ep[-1]]) } tz } `period.min` <- function(x,INDEX) { if(NCOL(x) > 1) stop("single column data only") if(min(INDEX) < 0 || max(INDEX) > NROW(x)) stop("INDEX must be >= 0 and <= nrow(x)") ep <- as.integer(INDEX) if(ep[1] != 0L) ep <- c(0L,ep) if(ep[length(ep)] != NROW(x)) ep <- c(ep,NROW(x)) xx <- as.double(x) xa <- .Call(C_xts_period_min, xx, ep) if(timeBased(index(x))) { tz <- xts(xa, index(x)[ep[-1]]) } else { tz <- zoo(xa, index(x)[ep[-1]]) } tz } xts/R/index.R0000644000176200001440000001263314525744640012543 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . index.xts <- time.xts <- function(x, ...) { value <- tclass(x) if(is.null(value) || !nzchar(value[1L])) { warning("index does not have a ", sQuote("tclass"), " attribute\n", " returning c(\"POSIXct\", \"POSIXt\")") ix <- .index(x) attr(ix, "tclass") <- attr(ix, "class") <- c("POSIXct", "POSIXt") return(ix) } # if tclass is Date, POSIXct time is set to 00:00:00 GMT. Convert here # to avoid ugly and hard to debug TZ conversion. What will this break? if(value[[1]] == "Date") #return( as.Date(.index(x)/86400) ) return( structure(.index(x) %/% 86400, class="Date")) #x.index <- structure(.index(x), class=c("POSIXct","POSIXt")) x.index <- .POSIXct(.index(x), tz=attr(.index(x), "tzone")) if(!is.list(value)) value <- as.list(value) switch(value[[1]], multitime = as.Date(as.character(x.index)), POSIXt = { # get specific ct/lt value do.call(paste('as',value[[2]],sep='.'),list(x.index)) }, POSIXct = as.POSIXct(x.index), POSIXlt = as.POSIXlt(x.index), timeDate = { if(!requireNamespace("timeDate", quietly=TRUE)) stop("package:",dQuote("timeDate"),"cannot be loaded.") timeDate::as.timeDate(x.index) }, chron = , dates = { if(!requireNamespace("chron", quietly=TRUE)) stop("package:",dQuote("chron"),"cannot be loaded.") chron::as.chron(format(x.index)) }, #Date = as.Date(as.character(x.index)), # handled above yearmon = as.yearmon(x.index), yearqtr = as.yearqtr(x.index), stop(paste('unsupported',sQuote('tclass'),'indexing type:',value[[1]])) ) } `time<-.xts` <- `index<-.xts` <- function(x, value) { if(length(index(x)) != length(value)) stop('length of index vectors does not match') if( !timeBased(value) ) stop(paste('unsupported',sQuote('index'), 'index type of class',sQuote(class(value)))) # copy original index attributes ixattr <- attributes(attr(x, 'index')) # set index to the numeric value of the desired index class if(inherits(value,"Date")) attr(x, 'index') <- structure(unclass(value)*86400, tclass="Date", tzone="UTC") else attr(x, 'index') <- as.numeric(as.POSIXct(value)) # ensure new index is sorted if(!isOrdered(.index(x), strictly=FALSE)) stop("new index needs to be sorted") # set tclass attribute to the end-user specified class attr(attr(x, 'index'), 'tclass') <- class(value) # set tzone attribute if(isClassWithoutTZ(object = value)) { attr(attr(x, 'index'), 'tzone') <- 'UTC' } else { if (is.null(attr(value, 'tzone'))) { # ensure index has tzone attribute if value does not attr(attr(x, 'index'), 'tzone') <- ixattr[["tzone"]] } else { attr(attr(x, 'index'), 'tzone') <- attr(value, 'tzone') } } return(x) } `.index` <- function(x, ...) { if(is.list(attr(x, "index"))) { attr(x, 'index')[[1]] } else attr(x, "index") } `.index<-` <- function(x, value) { if(timeBased(value)) { if(inherits(value, 'Date')) { attr(x, 'index') <- as.numeric(value) } else { attr(x, 'index') <- as.numeric(as.POSIXct(value)) } } else if(is.numeric(value)) { attr(value, 'tclass') <- tclass(x) attr(value, 'tzone') <- tzone(x) attr(x, 'index') <- value } else stop(".index is used for low level operations - data must be numeric or timeBased") return(x) } `.indexsec` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$sec } `.indexmin` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$min } `.indexhour` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$hour } `.indexmday` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$mday } `.indexmon` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$mon } `.indexyear` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$year } `.indexwday` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$wday } `.indexbday` <- function(x) { # is business day T/F as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$wday %% 6 > 0 } `.indexyday` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$yday } `.indexisdst` <- function(x) { as.POSIXlt(.POSIXct(.index(x), tz=tzone(x)))$isdst } `.indexDate` <- `.indexday` <- function(x) { .index(x) %/% 86400L } `.indexweek` <- function(x) { (.index(x) + (3 * 86400)) %/% 86400 %/% 7 } `.indexyweek` <- function(x) { ((.index(x) + (3 * 86400)) %/% 86400 %/% 7) - ((startOfYear() * 86400 + (3 * 86400)) %/% 86400 %/% 7)[.indexyear(x) + 1] } .update_index_attributes <- function(x) { suppressWarnings({ tclass(x) <- tclass(x) tzone(x) <- tzone(x) }) return(x) } xts/R/xts.R0000644000176200001440000002757614525744640012266 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # xts core functions # additional methods are in correspondingly named .R files # current conversions include: # timeSeries, its, irts, ts, matrix, data.frame, and zoo # MISSING: tis, fame # # this file includes the main xts constructor as well as the reclass # function. # # xts methods (which match foreign conversion methods in other files) # are also defined below # xts() index attribute precedence should be: # 1. .index* value (e.g. .indexTZ) # backward compatibility # 2. t* value (e.g. tzone) # current function to override index attribute # 3. attribute on order.by # overridden by either 2 above # # Do we always have to override the value of an existing tzone on the index # because the default value is Sys.getenv("TZ")? # # .xts() index attribute precedence is similar. But we cannot override tclass # because it's a formal argument with a specific default. Historically .xts() # has always set the tclass to POSIXct by default, whether or not the 'index' # argument already had a tclass attribute. `xts` <- function(x=NULL, order.by=index(x), frequency=NULL, unique=TRUE, tzone=Sys.getenv("TZ"), ...) { if(is.null(x) && missing(order.by)) return(.xts(NULL, integer())) if(!timeBased(order.by)) stop("order.by requires an appropriate time-based object") #if(NROW(x) != length(order.by)) if(NROW(x) > 0 && NROW(x) != length(order.by)) stop("NROW(x) must match length(order.by)") order.by_ <- order.by # make local copy and don't change order.by if(inherits(order.by, 'Date')) { # convert to GMT POSIXct if specified order.by_ <- .POSIXct(unclass(order.by) * 86400, tz = "UTC") } if(!isOrdered(order.by_, strictly = !unique)) { indx <- order(order.by_) if(!is.null(x)) { if(NCOL(x) > 1 || is.matrix(x) || is.data.frame(x)) { x <- x[indx,,drop=FALSE] } else x <- x[indx] } order.by_ <- order.by_[indx] } if(is.null(x)) { x <- numeric(0) } else if (is.list(x)) { # list or data.frame if (is.data.frame(x)) { x <- as.matrix(x) } else { stop("cannot convert lists to xts objects") } } else if (NROW(x) > 0) { x <- as.matrix(x) } # else 'x' is a zero-length vector. Do not *add* dims via as.matrix(). # It's okay if 'x' already has dims. if(inherits(order.by, "dates")) { fmt <- "%m/%d/%y" if(inherits(order.by, "chron")) { fmt <- paste0("(", fmt, " %H:%M:%S)") } order.by_ <- strptime(as.character(order.by_), fmt) # POSIXlt } index <- as.numeric(as.POSIXct(order.by_)) if(any(!is.finite(index))) stop("'order.by' cannot contain 'NA', 'NaN', or 'Inf'") # process index attributes ctor.call <- match.call(expand.dots = TRUE) tformat. <- attr(order.by, "tformat") if(hasArg(".indexFORMAT")) { warning(sQuote(".indexFORMAT"), " is deprecated, use tformat instead.") tformat. <- eval.parent(ctor.call$.indexFORMAT) } else if(hasArg("tformat")) { tformat. <- eval.parent(ctor.call$tformat) } tclass. <- attr(order.by, "tclass") if(hasArg(".indexCLASS")) { warning(sQuote(".indexCLASS"), " is deprecated, use tclass instead.") tclass. <- eval.parent(ctor.call$.indexCLASS) } else if(hasArg("tclass")) { tclass. <- eval.parent(ctor.call$tclass) } else if(is.null(tclass.)) { tclass. <- class(order.by) if(inherits(order.by, "POSIXt")) { #tclass. <- tclass.[tclass. != "POSIXt"] } } tzone. <- tzone # default Sys.getenv("TZ") if(hasArg(".indexTZ")) { warning(sQuote(".indexTZ"), " is deprecated, use tzone instead.") tzone. <- eval.parent(ctor.call$.indexTZ) } else if(hasArg("tzone")) { tzone. <- eval.parent(ctor.call$tzone) } else { # no tzone argument if(inherits(order.by, "timeDate")) { tzone. <- order.by@FinCenter } else if(!is.null(attr(order.by, "tzone"))) { tzone. <- attr(order.by, "tzone") } } if(isClassWithoutTZ(object = order.by)) { if((hasArg(".indexTZ") || hasArg("tzone")) && !isUTC(tzone.)) { warning(paste(sQuote('tzone'),"setting ignored for ", paste(class(order.by), collapse=", "), " indexes")) } tzone. <- "UTC" # change anything in isUTC() to UTC } # xts' tzone must only contain one element (POSIXlt tzone has 3) tzone. <- tzone.[1L] x <- structure(.Data = x, index = structure(index, tzone = tzone., tclass = tclass., tformat = tformat.), class=c('xts','zoo'), ...) # remove any index attributes that came through '...' index.attr <- c(".indexFORMAT", "tformat", ".indexCLASS", "tclass", ".indexTZ", "tzone") for(iattr in index.attr) { attr(x, iattr) <- NULL } if(!is.null(attributes(x)$dimnames[[1]])) # this is very slow if user adds rownames, but maybe that is deserved :) dimnames(x) <- dimnames(x) # removes row.names x } `.xts` <- function(x=NULL, index, tclass=c("POSIXct","POSIXt"), tzone=Sys.getenv("TZ"), check=TRUE, unique=FALSE, ...) { if(check) { if( !isOrdered(index, increasing=TRUE, strictly=unique) ) stop('index is not in ',ifelse(unique, 'strictly', ''),' increasing order') } index_out <- index if(!is.numeric(index) && timeBased(index)) index_out <- as.numeric(as.POSIXct(index)) if(!is.null(x) && NROW(x) != length(index)) stop("index length must match number of observations") if(any(!is.finite(index_out))) stop("'index' cannot contain 'NA', 'NaN', or 'Inf'") if(!is.null(x)) { if(!is.matrix(x)) x <- as.matrix(x) } else if(length(x) == 0 && !is.null(x)) { x <- vector(storage.mode(x)) } else x <- numeric(0) # process index attributes ctor.call <- match.call(expand.dots = TRUE) tformat. <- attr(index, "tformat") if(hasArg(".indexFORMAT")) { warning(sQuote(".indexFORMAT"), " is deprecated, use tformat instead.") tformat. <- eval.parent(ctor.call$.indexFORMAT) } else if(hasArg("tformat")) { tformat. <- eval.parent(ctor.call$tformat) } tclass. <- tclass # default POSIXct if(hasArg(".indexCLASS")) { warning(sQuote(".indexCLASS"), " is deprecated, use tclass instead.") tclass. <- eval.parent(ctor.call$.indexCLASS) } else if(hasArg("tclass")) { tclass. <- eval.parent(ctor.call$tclass) } else { # no tclass argument tclass. <- attr(index, "tclass") if(is.null(tclass.) && timeBased(index)) { tclass. <- class(index) } else { if(!identical(tclass., c("POSIXct", "POSIXt"))) { # index argument has 'tclass' attribute but it will be ignored # FIXME: # This warning causes errors in dependencies (e.g. portfolioBacktest, # when the warning is thrown from PerformanceAnalytics). Reinstate this # warning after fixing downstream packages. # warning("the index tclass attribute is ", index.class, # " but will be changed to (POSIXct, POSIXt)") tclass. <- tclass # default POSIXct } } } tzone. <- tzone # default Sys.getenv("TZ") if(hasArg(".indexTZ")) { warning(sQuote(".indexTZ"), " is deprecated, use tzone instead.") tzone. <- eval.parent(ctor.call$.indexTZ) } else if(hasArg("tzone")) { tzone. <- eval.parent(ctor.call$tzone) } else { # no tzone argument if(inherits(index, "timeDate")) { tzone. <- index@FinCenter } else if(!is.null(attr(index, "tzone"))) { tzone. <- attr(index, "tzone") } } if(isClassWithoutTZ(object = index)) { if((hasArg(".indexTZ") || hasArg("tzone")) && !isUTC(tzone.)) { warning(paste(sQuote('tzone'),"setting ignored for ", paste(class(index), collapse=", "), " indexes")) } tzone. <- "UTC" # change anything in isUTC() to UTC } # xts' tzone must only contain one element (POSIXlt tzone has 3) tzone <- tzone[1L] xx <- .Call(C_add_xtsCoreAttributes, x, index_out, tzone., tclass., c('xts','zoo'), tformat.) # remove any index attributes that came through '...' # and set any user attributes (and/or dim, dimnames, etc) dots.names <- eval(substitute(alist(...))) if(length(dots.names) > 0L) { dot.attrs <- list(...) drop.attr <- c(".indexFORMAT", "tformat", ".indexCLASS", ".indexTZ") dot.attrs[drop.attr] <- NULL attributes(xx) <- c(attributes(xx), dot.attrs) } # ensure there are no rownames (they may have come though dimnames) rn <- dimnames(xx)[[1]] if(!is.null(rn)) { attr(xx, '.ROWNAMES') <- rn dimnames(xx)[1] <- list(NULL) } xx } `reclass` <- function(x, match.to, error=FALSE, ...) { if(!missing(match.to) && is.xts(match.to)) { if(NROW(x) != length(.index(match.to))) if(error) { stop('incompatible match.to attibutes') } else return(x) if(!is.xts(x)) { x <- .xts(coredata(x), .index(match.to), tclass = tclass(match.to), tzone = tzone(match.to), tformat = tformat(match.to)) } attr(x, ".CLASS") <- CLASS(match.to) xtsAttributes(x) <- xtsAttributes(match.to) tclass(x) <- tclass(match.to) tformat(x) <- tformat(match.to) tzone(x) <- tzone(match.to) } oldCLASS <- CLASS(x) # should this be is.null(oldCLASS)? if(length(oldCLASS) > 0 && !inherits(oldClass,'xts')) { if(!is.null(dim(x))) { if(!is.null(attr(x,'.ROWNAMES'))) { # rownames<- (i.e. dimnames<-.xts) will not set row names # force them directly attr(x, "dimnames")[[1]] <- attr(x,'.ROWNAMES')[1:NROW(x)] } } attr(x,'.ROWNAMES') <- NULL #if(is.null(attr(x,'.RECLASS')) || attr(x,'.RECLASS')) {#should it be reclassed? if(isTRUE(attr(x,'.RECLASS'))) {#should it be reclassed? #attr(x,'.RECLASS') <- NULL do.call(paste('re',oldCLASS,sep='.'),list(x)) } else { #attr(x,'.RECLASS') <- NULL x } } else { #attr(x,'.RECLASS') <- NULL x } } #`reclass` <- reclass2 `CLASS` <- function(x) { cl <- attr(x,'.CLASS') if(!is.null(cl)) { attr(cl, 'class') <- 'CLASS' return(cl) } return(NULL) } `print.CLASS` <- function(x,...) { cat(paste("previous class:",x),"\n") } `CLASS<-` <- function(x,value) { UseMethod("CLASS<-") } `CLASS<-.xts` <- function(x,value) { attr(x,".CLASS") <- value x } `is.xts` <- function(x) { inherits(x,'xts') && is.numeric(.index(x)) && !is.null(tclass(x)) } `as.xts` <- function(x,...) { UseMethod('as.xts') } #as.xts.default <- function(x, ...) x `re.xts` <- function(x,...) { # simply return the object return(x) } `as.xts.xts` <- function(x,...,.RECLASS=FALSE) { # Cannot use 'zoo()' on objects of class 'zoo' or '.CLASS' (etc.?) # Is the equivalent of a 'coredata.xts' needed? - jmu #yy <- coredata(x) #attr(yy, ".CLASS") <- NULL # using new coredata.xts method - jar if(length(x) == 0 && (!is.null(index(x)) && length(index(x))==0)) return(x) if(.RECLASS) { xx <- xts(coredata(x), order.by=index(x), .CLASS='xts', ...) } else { xx <- xts(coredata(x), order.by=index(x), ...) } xx } `xts.to.xts` <- function(x,...) { return(x) } xts/R/utils.R0000644000176200001440000000202714522244665012567 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . naCheck <- function(x, n=0) { if(is.null(dim(x)[2])) { NAs <- .Call(C_naCheck, x, TRUE) } else NAs <- .Call(C_naCheck, rowSums(x), TRUE) ret <- list() ret$NAs <- NAs ret$nonNA <- (1+NAs):NROW(x) ret$beg <- n+NAs invisible(ret) } xts/R/periodicity.R0000644000176200001440000001167514522244665013764 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . time_frequency <- function(x) { x <- gsub(":|/|-| ", "", x) nc <- nchar(x) if(nc < 4) stop("unrecognizable time.scale") if(nc == 4) res <- 2678400 * 12 #"yearly" if(nc > 4) res <- 2678400 #"monthly" if(nc > 6) res <- 86400 #"daily" if(nc > 8) res <- 3600 #"hourly" if(nc > 10) res <- 60 #"minute" if(nc > 12) res <- 1 #"seconds" return(res) } periodicity <- function(x, ...) { if( timeBased(x) ) { if( anyNA(x) ) { warning("removing NA in 'x' to calculate periodicity") x <- x[!is.na(x)] } x <- try.xts(x, error = "cannot convert 'x' to xts") } if (!is.xts(x)) { x <- try.xts(x, error = "cannot convert 'x' to xts") } n <- length(.index(x)) if( n < 2 ) { res <- list(difftime = structure(0, units='secs', class='difftime'), frequency = 0, start = NA, end = NA, units = 'secs', scale = 'seconds', label = 'second') res <- structure(res, class='periodicity') if( n == 0 ) { warning("can not calculate periodicity of empty object") } else { warning("can not calculate periodicity of 1 observation") res$start <- start(x) res$end <- end(x) } return(res) } p <- median(diff( .index(x) )) # Date and POSIXct if(p < 60) { units <- "secs" scale <- "seconds" label <- "second" } else if(p < 3600) { units <- "mins" scale <- "minute" label <- "minute" p <- p/60L } else if(p < 86400) { # < 1 day units <- "hours" scale <- "hourly" label <- "hour" } else if(p == 86400) { units <- "days" scale <- "daily" label <- "day" } else if(p <= 604800) { # 86400 * 7 units <- "days" scale <- "weekly" label <- "week" } else if(p <= 2678400) { # 86400 * 31 units <- "days" scale <- "monthly" label <- "month" } else if(p <= 7948800) { # 86400 * 92 units <- "days" scale <- "quarterly" label <- "quarter" } else { # years units <- "days" scale <- "yearly" label <- "year" } structure(list(difftime = as.difftime(p, units = units), frequency = p, start = start(x), end = end(x), units = units, scale = scale, label = label), class = 'periodicity') } `periodicity.old` <- function (x, ...) { if(!is.xts(x)) x <- as.xts(x) # convert if necessary to usable format if(!tclass(x)[[1]] %in% c('Date','POSIXt')) tclass(x) <- "POSIXct" # this takes a long time on big data - possibly use some sort of sampling instead??? p <- median(diff(time(x))) if (is.na(p)) stop("cannot calculate periodicity from one observation") p.numeric <- as.numeric(p) units <- attr(p, "units") if (units == "secs") { scale <- "seconds" } if (units == "mins") { scale <- "minute" if (p.numeric > 59) scale <- "hourly" } if (units == "hours") { scale <- "hourly" } if (units == "days") { scale <- "daily" if (p.numeric > 1) scale <- "weekly" if (p.numeric > 7) scale <- "monthly" if (p.numeric > 31) scale <- "quarterly" if (p.numeric > 91) scale <- "yearly" } structure(list(difftime = p, frequency = p.numeric, start = index(first(x)), end = index(last(x)), units = units, scale = scale),class="periodicity") # class(xx) <- "periodicity" # xx # used when structure was assigned to xx, useless now, remain until testing is done though -jar } `print.periodicity` <- function (x, ...) { x.freq <- ifelse(x$scale %in% c("minute", "seconds"), x$frequency, "") if (x.freq == "") { cap.scale <- paste(toupper(substring(x$scale, 1, 1)), substring(x$scale, 2), sep = "") cat(paste(cap.scale, "periodicity from", x$start, "to", x$end, "\n", sep = " ")) } else { cat(paste(x.freq, x$scale, "periodicity from", x$start, "to", x$end, "\n", sep = " ")) } } xts/R/zzz.R0000644000176200001440000001034614522244665012267 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # internal package environment for use with lines.xts # Do we still need this env? .xtsEnv <- new.env() # Environment for our xts chart objects (xts_chob) .plotxtsEnv <- new.env() register_s3_method <- function(pkg, generic, class, fun = NULL) { stopifnot(is.character(pkg), length(pkg) == 1L) stopifnot(is.character(generic), length(generic) == 1L) stopifnot(is.character(class), length(class) == 1L) if (is.null(fun)) { fun <- get(paste0(generic, ".", class), envir = parent.frame()) } else { stopifnot(is.function(fun)) } if (isNamespaceLoaded(pkg)) { registerS3method(generic, class, fun, envir = asNamespace(pkg)) } # Always register hook in case package is later unloaded & reloaded setHook( packageEvent(pkg, "onLoad"), function(...) { registerS3method(generic, class, fun, envir = asNamespace(pkg)) } ) } .onAttach <- function(libname, pkgname) { warn_dplyr_lag <- getOption("xts.warn_dplyr_breaks_lag", TRUE) dplyr_will_mask_lag <- conflictRules("dplyr") if (is.null(dplyr_will_mask_lag)) { dplyr_will_mask_lag <- TRUE } else { dplyr_will_mask_lag <- all(dplyr_will_mask_lag$exclude != "lag") } if (warn_dplyr_lag && dplyr_will_mask_lag) { ugly_message <- " ######################### Warning from 'xts' package ########################## # # # The dplyr lag() function breaks how base R's lag() function is supposed to # # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or # # source() into this session won't work correctly. # # # # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add # # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop # # dplyr from breaking base R's lag() function. # # # # Code in packages is not affected. It's protected by R's namespace mechanism # # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. # # # ###############################################################################" if ("package:dplyr" %in% search()) { packageStartupMessage(ugly_message) } else { setHook(packageEvent("dplyr", "attach"), function(...) packageStartupMessage(ugly_message)) } } } .onLoad <- function(libname, pkgname) { # if(Sys.getenv("TZ") == "") { # packageStartupMessage("xts now requires a valid TZ environment variable to be set") # packageStartupMessage(" no TZ var is set, setting to TZ=GMT") # Sys.setenv(TZ="GMT") # } else { # packageStartupMessage("xts now requires a valid TZ environment variable to be set") # packageStartupMessage(" your current TZ:",paste(Sys.getenv("TZ"))) # } if (getRversion() < "3.6.0") { register_s3_method("timeSeries", "as.timeSeries", "xts") if (utils::packageVersion("zoo") < "1.8.5") { # xts:::as.zoo.xts was copied to zoo:::as.zoo.xts in zoo 1.8-5 register_s3_method("zoo", "as.zoo", "xts") } } invisible() } .onUnload <- function(libpath) { library.dynam.unload("xts", libpath) } if(getRversion() < "2.11.0") { .POSIXct <- function(xx, tz = NULL) structure(xx, class = c("POSIXct", "POSIXt"), tzone = tz) } xts/R/Date.R0000644000176200001440000000154314522244662012303 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `as.xts.Date` <- function(x,...) { xts(x=NULL,order.by=x,...) } xts/R/timeSeries.R0000644000176200001440000000564414522244665013550 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # functions to handle timeSeries <--> xts conversions `re.timeSeries` <- function(x,...) { if(!requireNamespace('timeSeries', quietly=TRUE)) { timeSeries <- function(...) message("package 'timeSeries' is required") } else { timeSeries <- timeSeries::timeSeries } # strip all non-'core' attributes so they're not attached to the Data slot x.attr <- attributes(x) xx <- structure(x,dimnames=x.attr$dimnames,index=x.attr$index) original.attr <- attributes(x)[!names(attributes(x)) %in% c("dim","dimnames","index","class")] for(i in names(original.attr)) { attr(xx,i) <- NULL } timeSeries(coredata(xx),charvec=as.POSIXct(format(index(x)),tz="GMT"),format=x.attr$format, zone=x.attr$FinCenter,FinCenter=x.attr$FinCenter, recordIDs=x.attr$recordIDs,title=x.attr$title, documentation=x.attr$documentation,...) } `as.xts.timeSeries` <- function(x,dateFormat="POSIXct",FinCenter,recordIDs,title,documentation,..., .RECLASS=FALSE) { if(missing(FinCenter)) FinCenter <- x@FinCenter if(missing(recordIDs)) recordIDs <- x@recordIDs if(missing(title)) title <- x@title if(missing(documentation)) documentation <- x@documentation indexBy <- structure(x@positions, class=c("POSIXct","POSIXt"), tzone=FinCenter) order.by <- do.call(paste('as',dateFormat,sep='.'),list(as.character(indexBy))) if(.RECLASS) { xts(as.matrix(x@.Data), order.by=order.by, format=x@format, FinCenter=FinCenter, recordIDs=recordIDs, title=title, documentation=documentation, .CLASS='timeSeries', .CLASSnames=c('FinCenter','recordIDs','title','documentation','format'), .RECLASS=TRUE, ...) } else { xts(as.matrix(x@.Data), order.by=order.by, ...) } } as.timeSeries.xts <- function(x, ...) { if(!requireNamespace('timeSeries', quietly=TRUE)) { timeSeries <- function(...) message("package 'timeSeries' is required") } else { timeSeries <- timeSeries::timeSeries } timeSeries(data=coredata(x), charvec=as.character(index(x)), ...) } `xts.as.timeSeries` <- function(x,...) {} xts/R/align.time.R0000644000176200001440000000467314522244662013464 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . align.time <- function(x, ...) { UseMethod("align.time") } align.time.xts <- function(x, n=60, ...) { if(n <= 0) stop("'n' must be positive") .xts(x, .index(x) + (n-.index(x) %% n), tzone=tzone(x), tclass=tclass(x)) } align.time.POSIXct <- function(x, n=60, ...) { if(n <= 0) stop("'n' must be positive") structure(unclass(x) + (n - unclass(x) %% n),class=c("POSIXct","POSIXt")) } align.time.POSIXlt <- function(x, n=60, ...) { if(n <= 0) stop("'n' must be positive") as.POSIXlt(align.time(as.POSIXct(x),n=n,...)) } shift.time <- function(x, n=60, ...) { UseMethod("shift.time") } shift.time.xts <- function(x, n=60, ...) { .xts(x, .index(x) + n, tzone=tzone(x), tclass=tclass(x)) } is.index.unique <- is.time.unique <- function(x) { UseMethod("is.time.unique") } is.time.unique.xts <- function(x) { isOrdered(.index(x), strictly=TRUE) } is.time.unique.zoo <- function(x) { isOrdered(index(x), strictly=TRUE) } make.index.unique <- make.time.unique <- function(x, eps=0.000001, drop=FALSE, fromLast=FALSE, ...) { UseMethod("make.index.unique") } make.index.unique.xts <- function(x, eps=0.000001, drop=FALSE, fromLast=FALSE, ...) { if( !drop) { .Call(C_make_index_unique, x, eps) } else { x[.Call(C_non_duplicates, .index(x), fromLast)] } } make.index.unique.numeric <- function(x, eps=0.000001, drop=FALSE, fromLast=FALSE, ...) { if( !drop) { .Call(C_make_unique, x, eps) } else { x[.Call(C_non_duplicates, x, fromLast)] } } make.index.unique.POSIXct <- function(x, eps=0.000001, drop=FALSE, fromLast=FALSE, ...) { if( !drop) { .Call(C_make_unique, x, eps) } else { x[.Call(C_non_duplicates, x, fromLast)] } } xts/R/split.R0000644000176200001440000000411214522244665012557 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . split.xts <- function(x, f="months", drop=FALSE, k=1, ...) { if(is.character(f) && length(f) == 1L) { ep <- endpoints(x, on=f, k=k) sp <- (ep + 1)[-length(ep)] ep <- ep[-1] out <- lapply(seq_along(ep), function(X) x[sp[X]:ep[X]]) if(f == "secs" || f == "mins") { f <- substr(f, 1L, 3L) } f <- match.arg(f, c("years", "quarters", "months", "weeks", "days", "hours", "minutes", "seconds", "milliseconds", "microseconds", "ms", "us")) obs.for.names <- index(x)[sp] outnames <- switch(f, "years" = format(obs.for.names, "%Y"), "quarters" = as.character(as.yearqtr(as.POSIXlt(obs.for.names))), "months" = format(obs.for.names, "%b %Y"), "weeks" = format(obs.for.names, "%Y-%m-%d"), "days" = format(obs.for.names, "%Y-%m-%d"), "hours" = format(obs.for.names, "%Y-%m-%d %H:00:00"), "minutes" = format(obs.for.names, "%Y-%m-%d %H:%M:00"), "seconds" = format(obs.for.names, "%Y-%m-%d %H:%M:%S"), "milliseconds" = , "ms" = format(obs.for.names, "%Y-%m-%d %H:%M:%OS3"), "microseconds" = , "us" = format(obs.for.names, "%Y-%m-%d %H:%M:%OS6")) setNames(out, outnames) } else NextMethod("split") } xts/R/modify.args.R0000644000176200001440000000500714522244664013651 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2009-2015 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Ross Bennett and Joshua M. Ulrich # # 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, see . modify.args <- function(formals, arglist, ..., dots=FALSE) { # modify.args function from quantstrat # avoid evaluating '...' to make things faster dots.names <- eval(substitute(alist(...))) if(missing(arglist)) arglist <- NULL arglist <- c(arglist, dots.names) # see 'S Programming' p. 67 for this matching # nothing to do if arglist is empty; return formals as a list if(!length(arglist)) return(as.list(formals)) argnames <- names(arglist) if(!is.list(arglist) && !is.null(argnames) && !any(argnames == "")) stop("'arglist' must be a *named* list, with no names == \"\"") .formals <- formals onames <- names(.formals) pm <- pmatch(argnames, onames, nomatch = 0L) #if(any(pm == 0L)) # message(paste("some arguments stored for", fun, "do not match")) names(arglist[pm > 0L]) <- onames[pm] .formals[pm] <- arglist[pm > 0L] # include all elements from arglist if function formals contain '...' if(dots && !is.null(.formals$...)) { dotnames <- names(arglist[pm == 0L]) .formals[dotnames] <- arglist[dotnames] #.formals$... <- NULL # should we assume we matched them all? } # return a list (not a pairlist) as.list(.formals) } # This is how it is used in quantstrat in applyIndicators() # # replace default function arguments with indicator$arguments # .formals <- formals(indicator$name) # .formals <- modify.args(.formals, indicator$arguments, dots=TRUE) # # now add arguments from parameters # .formals <- modify.args(.formals, parameters, dots=TRUE) # # now add dots # .formals <- modify.args(.formals, NULL, ..., dots=TRUE) # # remove ... to avoid matching multiple args # .formals$`...` <- NULL # # tmp_val <- do.call(indicator$name, .formals) xts/R/all.equal.R0000644000176200001440000000307314522244662013304 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2019 Joshua M. Ulrich # # 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, see . all.equal.xts <- function(target, current, ..., check.attributes = TRUE) { if (isTRUE(check.attributes)) { # Remove potential index attributes on the objects attrNames <- c(".indexCLASS", ".indexTZ", "tclass", "tzone") for (aname in attrNames) { attr(target, aname) <- NULL attr(current, aname) <- NULL } # Order the object attributes a <- attributes(target) attributes(target) <- a[sort(names(a))] a <- attributes(current) attributes(current) <- a[sort(names(a))] # Order the index attributes a <- attributes(.index(target)) attributes(.index(target)) <- a[sort(names(a))] a <- attributes(.index(current)) attributes(.index(current)) <- a[sort(names(a))] } NextMethod("all.equal") } xts/R/nperiods.R0000644000176200001440000000245714522244665013261 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `nseconds` <- function(x) { length(endpoints(x,on='seconds'))-1 } `nminutes` <- function(x) { length(endpoints(x,on='minutes'))-1 } `nhours` <- function(x) { length(endpoints(x,on='hours'))-1 } `ndays` <- function(x) { length(endpoints(x,on='days'))-1 } `nweeks` <- function(x) { length(endpoints(x,on='weeks'))-1 } `nmonths` <- function(x) { length(endpoints(x,on='months'))-1 } `nquarters` <- function(x) { length(endpoints(x,on='quarters'))-1 } `nyears` <- function(x) { length(endpoints(x,on='years'))-1 } xts/R/coredata.xts.R0000644000176200001440000000766714522244662014042 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . coredata.xts <- function(x, fmt=FALSE, ...) { x.attr <- attributes(x) if(is.character(fmt)) { tformat(x) <- fmt fmt <- TRUE } if(length(x) > 0 && fmt) { if(!is.null(tformat(x))) { x.attr$dimnames <- list(format(index(x), format=tformat(x)), dimnames(x)[[2]]) tformat(x) <- NULL # remove before printing } else { x.attr$dimnames <- list(format(index(x)),dimnames(x)[[2]]) } #attributes not to be kept original.attr <- x.attr[!names(x.attr) %in% c('dim','dimnames')] if(is.null(dim(x))) { xx <- structure(coredata(x), names=x.attr$dimnames[[1]]) } else { xx <- structure(coredata(x), dim=dim(x), dimnames=x.attr$dimnames) } for(i in names(original.attr)) { attr(xx,i) <- NULL } return(xx) } if(length(x) == 0) { xx <- NextMethod(x) attr(xx, ".indexCLASS") <- NULL attr(xx, "tclass") <- NULL # Remove tz attrs (object created before 0.10-3) attr(xx, ".indexTZ") <- NULL attr(xx, "tzone") <- NULL return(xx) } else return(.Call(C_coredata_xts, x)) } `xcoredata.default` <- function(x,...) { x.attr <- attributes(x) original.attr <- x.attr[!names(x.attr) %in% c('dim','dimnames')] original.attr } `xcoredata` <- function(x,...) { UseMethod('xcoredata') } `xcoredata<-` <- function(x,value) { UseMethod('xcoredata<-') } `xcoredata<-.default` <- function(x,value) { if(is.null(value)) { return(coredata(x)) } else { for(att in names(value)) { if(!att %in% c('dim','dimnames')) attr(x,att) <- value[[att]] } return(x) } } `xtsAttributes` <- function(x, user=NULL) { # get all additional attributes not standard to xts object #stopifnot(is.xts(x)) rm.attr <- c('dim','dimnames','index','class','names') x.attr <- attributes(x) if(is.null(user)) { # Both xts and user attributes rm.attr <- c(rm.attr,'.CLASS','.CLASSnames','.ROWNAMES', '.indexCLASS', '.indexFORMAT', '.indexTZ', 'tzone', 'tclass') xa <- x.attr[!names(x.attr) %in% rm.attr] } else if(user) { # Only user attributes rm.attr <- c(rm.attr,'.CLASS','.CLASSnames','.ROWNAMES', '.indexCLASS', '.indexFORMAT','.indexTZ','tzone','tclass', x.attr$.CLASSnames) xa <- x.attr[!names(x.attr) %in% rm.attr] } else { # Only xts attributes xa <- x.attr[names(x.attr) %in% x.attr$.CLASSnames] } if(length(xa) == 0) return(NULL) xa } `xtsAttributes<-` <- function(x,value) { UseMethod('xtsAttributes<-') } `xtsAttributes<-.xts` <- function(x,value) { if(is.null(value)) { for(nm in names(xtsAttributes(x))) { attr(x,nm) <- NULL } } else for(nv in names(value)) { if(!nv %in% c('dim','dimnames','index','class','.CLASS','.ROWNAMES','.CLASSnames')) attr(x,nv) <- value[[nv]] } # Remove tz attrs (object created before 0.10-3) attr(x, ".indexTZ") <- NULL attr(x, "tzone") <- NULL # Remove index class attrs (object created before 0.10-3) attr(x, ".indexCLASS") <- NULL attr(x, "tclass") <- NULL # Remove index format attr (object created before 0.10-3) attr(x, ".indexFORMAT") <- NULL x } xts/R/toperiod.R0000644000176200001440000002071114525744640013255 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # to.period functionality from quantmod # # to.period base function # to.minutes # to.hourly # to.daily # to.weekly # to.monthly # to.quarterly # to.yearly to.period <- to_period <- function(x, period='months', k=1, indexAt=NULL, name=NULL, OHLC=TRUE, ...) { if(missing(name)) name <- deparse(substitute(x)) xo <- x x <- try.xts(x) if(NROW(x)==0 || NCOL(x)==0) stop(sQuote("x")," contains no data") if(any(is.na(x))) { x <- na.omit(x) warning("missing values removed from data") } if(is.character(period)) { ep <- endpoints(x, period, k) } else { if(!is.numeric(period)) { stop("'period' must be a character or a vector of endpoint locations") } if(!missing("k")) { warning("'k' is ignored when using custom 'period' locations") } if(!is.null(indexAt)) { warning("'indexAt' is ignored when using custom 'period' locations") indexAt <- NULL } ep <- as.integer(period) # ensure 'ep' starts with 0 and ends with nrow(x) if(ep[1] != 0) { ep <- c(0L, ep) } if (ep[length(ep)] != NROW(x)) { ep <- c(ep, NROW(x)) } } if(!OHLC) { xx <- x[ep, ] } else { if(!is.null(indexAt)) { index_at <- switch(indexAt, "startof" = TRUE, # start time of period "endof" = FALSE, # end time of period FALSE ) } else index_at <- FALSE # make suitable name vector cnames <- c("Open", "High", "Low", "Close") if (has.Vo(x)) cnames <- c(cnames, "Volume") if (has.Ad(x) && is.OHLC(x)) cnames <- c(cnames, "Adjusted") cnames <- paste(name,cnames,sep=".") if(is.null(name)) cnames <- NULL xx <- .Call(C_toPeriod, x, ep, has.Vo(x), has.Vo(x,which=TRUE), has.Ad(x) && is.OHLC(x), index_at, cnames) } if(!is.null(indexAt)) { if(indexAt=="yearmon" || indexAt=="yearqtr") tclass(xx) <- indexAt if(indexAt=="firstof") { ix <- as.POSIXlt(c(.index(xx)), tz=tzone(xx)) if(period %in% c("years","months","quarters","days")) index(xx) <- firstof(ix$year + 1900, ix$mon + 1) else index(xx) <- firstof(ix$year + 1900, ix$mon + 1, ix$mday, ix$hour, ix$min, ix$sec) } if(indexAt=="lastof") { ix <- as.POSIXlt(c(.index(xx)), tz=tzone(xx)) if(period %in% c("years","months","quarters","days")) index(xx) <- as.Date(lastof(ix$year + 1900, ix$mon + 1)) else index(xx) <- lastof(ix$year + 1900, ix$mon + 1, ix$mday, ix$hour, ix$min, ix$sec) } } reclass(xx,xo) } `to.minutes` <- function(x,k,name,...) { if(missing(name)) name <- deparse(substitute(x)) if(missing(k)) k <- 1 to.period(x,'minutes',k=k,name=name,...) } `to.minutes3` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'minutes',k=3,name=name,...) } `to.minutes5` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'minutes',k=5,name=name,...) } `to.minutes10` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'minutes',k=10,name=name,...) } `to.minutes15` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'minutes',k=15,name=name,...) } `to.minutes30` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'minutes',k=30,name=name,...) } `to.hourly` <- function(x,name,...) { if(missing(name)) name <- deparse(substitute(x)) to.period(x,'hours',name=name,...) } `to.daily` <- function(x,drop.time=TRUE,name,...) { if(missing(name)) name <- deparse(substitute(x)) x <- to.period(x,'days',name=name,...) if(drop.time) x <- .drop.time(x) return(x) } `to.weekly` <- function(x,drop.time=TRUE,name,...) { if(missing(name)) name <- deparse(substitute(x)) x <- to.period(x,'weeks',name=name,...) if(drop.time) x <- .drop.time(x) return(x) } `to.monthly` <- function(x,indexAt='yearmon',drop.time=TRUE,name,...) { if(missing(name)) name <- deparse(substitute(x)) x <- to.period(x,'months',indexAt=indexAt,name=name,...) if(drop.time) x <- .drop.time(x) return(x) } `to.quarterly` <- function(x,indexAt='yearqtr',drop.time=TRUE,name,...) { if(missing(name)) name <- deparse(substitute(x)) x <- to.period(x,'quarters',indexAt=indexAt,name=name,...) if(drop.time) x <- .drop.time(x) return(x) } `to.yearly` <- function(x,drop.time=TRUE,name,...) { if(missing(name)) name <- deparse(substitute(x)) x <- to.period(x,'years',name=name,...) if(drop.time) x <- .drop.time(x) return(x) } `.drop.time` <- function(x) { # function to remove HHMMSS portion of time index xts.in <- is.xts(x) # is the input xts? if(!xts.in) # if not, try to convert to xts x <- try.xts(x, error=FALSE) if(is.xts(x)) { # if x is xts, drop HHMMSS from index if(any(tclass(x)=='POSIXt')) { # convert index to Date index(x) <- as.Date(as.POSIXlt(index(x))) tclass(x) <- "Date" # set tclass to Date } if(isClassWithoutTZ(tclass(x))) { tzone(x) <- "UTC" # set tzone to UTC } # force conversion, even if we didn't set tclass to Date # because indexAt yearmon/yearqtr won't drop time from index index(x) <- index(x) if(xts.in) x # if input already was xts else reclass(x) # if input wasn't xts, but could be converted } else x # if input wasn't xts, and couldn't be converted } `by.period` <- function(x, FUN, on=Cl, period="days", k=1, fill=na.locf, ...) { # aggregate 'x' to a higher periodicity, apply 'FUN' to the 'on' columns # of the aggregate, then merge the aggregate results with 'x' and fill NAs # with na.locf. E.g. you can apply a 5-day SMA of volume to tick data. x <- try.xts(x, error = FALSE) FUN <- match.fun(FUN) on <- match.fun(on) # Allow function or name agg <- to.period(x, period, k, ...) res <- FUN(on(agg), ...) full <- merge(.xts(NULL,index(x)),res) full <- fill(full) # Allow function or value return(full) } `to.frequency` <- function(x, by, k=1, name=NULL, OHLC=TRUE, ...) { # similar to to.period, but aggregates on something other than time. # E.g. aggregate by volume, where a "period" is 10% of the 5-day volume SMA. # Most code pulled from to.period if(missing(name)) name <- deparse(substitute(x)) xo <- x x <- try.xts(x) if(any(is.na(x))) { x <- na.omit(x) warning("missing values removed from data") } # if(!OHLC) { # xx <- x[endpoints(x, period, k),] # } else { # if(!is.null(indexAt)) { # index_at <- switch(indexAt, # "startof" = TRUE, # start time of period # "endof" = FALSE, # end time of period # FALSE # ) # } else index_at <- FALSE # make suitable name vector cnames <- c("Open", "High", "Low", "Close") if (has.Vo(x)) cnames <- c(cnames, "Volume") if (has.Ad(x) && is.OHLC(x)) cnames <- c(cnames, "Adjusted") cnames <- paste(name,cnames,sep=".") if(is.null(name)) cnames <- NULL # start to.frequency-specific code if (missing(by)) by <- rep(1L, nrow(x)) byVec <- cumsum(by) bins <- byVec %/% k # ep contents must have the same format as output generated by endpoints(): # first element must be zero and last must be nrow(x) ep <- c(0L, which(diff(bins) != 0)) if (ep[length(ep)] != nrow(bins)) ep <- c(ep, nrow(bins)) # end to.frequency-specific code xx <- .Call(C_toPeriod, x, ep, has.Vo(x), has.Vo(x,which=TRUE), has.Ad(x) && is.OHLC(x), FALSE, cnames) reclass(xx,xo) } xts/R/list.R0000644000176200001440000000213314522244664012377 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.list.xts <- function(x, ...) { if( NCOL(x) == 1 ) return(structure(list(x),.Names=colnames(x))) cindex <- cnames <- colnames(x) if(is.null(cnames)) { cindex <- 1:NCOL(x) cnames <- paste("x",cindex,sep=".") } names(cindex) <- cnames lapply(cindex, function(f) x[,f], ...) } xts/R/sort.xts.R0000644000176200001440000000175614522244665013243 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `sort.xts` <- function(x, decreasing=FALSE, MARGIN=1, ...) { if(NCOL(x) > 1) { as.matrix(x)[order(x[,MARGIN],decreasing=decreasing,...),] } else as.matrix(x)[order(x,decreasing=decreasing,...),] } xts/R/xts.methods.R0000644000176200001440000003127314522244665013714 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # window.xts contributed by Corwin Joy # # 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, see . .subsetTimeOfDay <- function(x, fromTimeString, toTimeString) { validateTimestring <- function(time) { h <- "(?:[01]?\\d|2[0-3])" hm <- paste0(h, "(?::?[0-5]\\d)") hms <- paste0(hm, "(?::?[0-5]\\d)") hmsS <- paste0(hms, "(?:\\.\\d{1,9})?") pattern <- paste(h, hm, hms, hmsS, sep = ")$|^(") pattern <- paste0("^(", pattern, "$)") if (!grepl(pattern, time)) { # FIXME: this isn't necessarily true... # colons aren't required, and neither are all of the components stop("Supply time-of-day subsetting in the format of T%H:%M:%OS/T%H:%M:%OS", call. = FALSE) } } validateTimestring(fromTimeString) validateTimestring(toTimeString) getTimeComponents <- function(time) { # split on decimal point time. <- strsplit(time, ".", fixed = TRUE)[[1]] hms <- time.[1L] # ensure hms string has even nchar nocolon <- gsub(":", "", hms, fixed = TRUE) if (nchar(nocolon) %% 2 > 0) { # odd nchar means leading zero is omitted from hours # all other components require zero padding hms <- paste0("0", hms) } # add colons hms <- gsub("(.{2}):?", ":\\1", hms, perl = TRUE) # remove first character (a colon) hms <- substr(hms, 2, nchar(hms)) # extract components comp <- strsplit(hms, ":", fixed = TRUE)[[1]] complist <- list(hour = comp[1L], min = comp[2L], sec = comp[3L], subsec = time.[2L]) # remove all missing components complist <- complist[!vapply(complist, is.na, logical(1))] # convert to numeric complist <- lapply(complist, as.numeric) # add timezone and return c(tz = "UTC", complist) } # first second in period (no subseconds) from <- do.call(firstof, getTimeComponents(fromTimeString)[-5L]) secBegin <- as.numeric(from) %% 86400L # last second in period to <- do.call(lastof, getTimeComponents(toTimeString)) secEnd <- as.numeric(to) %% 86400L # do subsetting tz <- tzone(x) secOfDay <- as.POSIXlt(index(x), tz = tz) secOfDay <- secOfDay$hour * 60 * 60 + secOfDay$min * 60 + secOfDay$sec if (secBegin <= secEnd) { i <- secOfDay >= secBegin & secOfDay <= secEnd } else { i <- secOfDay >= secBegin | secOfDay <= secEnd } which(i) } .subset_xts <- function(x, i, j, ...) { if(missing(i)) { i <- 1:NROW(x) } if(missing(j)) { j <- 1:NCOL(x) } .Call(C__do_subset_xts, x, i, j, FALSE) } `.subset.xts` <- `[.xts` <- function(x, i, j, drop = FALSE, which.i=FALSE,...) { USE_EXTRACT <- FALSE # initialize to FALSE dimx <- dim(x) if(is.null(dimx)) { nr <- length(x) if(nr==0 && !which.i) { idx <- index(x) if(length(idx) == 0) { # this is an empty xts object (zero-length index and no columns) # return it unchanged to match [.zoo return(x) } else { return(xts(rep(NA, length(idx)), idx)[i]) } } nr <- length(.index(x)) nc <- 1L } else { nr <- dimx[1L] nc <- dimx[2L] } if(!missing(i)) { # test for negative subscripting in i if (is.numeric(i)) { #if(any(i < 0)) { if(.Call(C_any_negative, i)) { if(!all(i <= 0)) stop('only zeros may be mixed with negative subscripts') i <- (1:nr)[i] } # check boundary; length check avoids Warning from max(), and # any_negative ensures no NA (as of r608) #if(max(i) > nr) if(length(i) > 0 && max(i) > nr) stop('subscript out of bounds') #i <- i[-which(i == 0)] } else if (timeBased(i) || (inherits(i, "AsIs") && is.character(i)) ) { # Fast binary search on set of dates i <- window_idx(x, index. = i) } else if(is.logical(i)) { i <- which(i) #(1:NROW(x))[rep(i,length.out=NROW(x))] } else if (is.character(i)) { time.of.day.pattern <- "(^/T)|(^T.*?/T)|(^T.*/$)" if (length(i) == 1 && !identical(integer(), grep(time.of.day.pattern, i[1]))) { # time of day subsetting ii <- gsub("T", "", i, fixed = TRUE) ii <- strsplit(ii, "/", fixed = TRUE)[[1L]] if (length(ii) == 1) { # i is right open ended (T.*/) ii <- c(ii, "23:59:59.999999999") } else if (nchar(ii[1L]) == 0) { # i is left open ended (/T) ii[1L] <- "00:00:00.000000000" } # else i is bounded on both sides (T.*/T.*) i <- .subsetTimeOfDay(x, ii[1L], ii[2L]) } else { # enables subsetting by date style strings # must be able to process - and then allow for operations??? i.tmp <- NULL tz <- as.character(tzone(x)) for(ii in i) { adjusted.times <- .parseISO8601(ii, .index(x)[1], .index(x)[nr], tz=tz) if(length(adjusted.times) > 1) { i.tmp <- c(i.tmp, index_bsearch(.index(x), adjusted.times$first.time, adjusted.times$last.time)) } } i <- i.tmp } i_len <- length(i) if(i_len == 1L) # IFF we are using ISO8601 subsetting USE_EXTRACT <- TRUE } if(!isOrdered(i,strictly=FALSE)) { i <- sort(i) } # subset is picky, 0's in the 'i' position cause failures zero.index <- binsearch(0L, i, FALSE) if(!is.na(zero.index)) { # at least one 0; binsearch returns location of last 0 i <- i[-(1L:zero.index)] } if(length(i) <= 0 && USE_EXTRACT) USE_EXTRACT <- FALSE if(which.i) return(i) } # if(!missing(i)) { end if (missing(j)) { if(missing(i)) i <- seq_len(nr) if(length(x)==0) { cdata <- rep(NA, length(i)) storage.mode(cdata) <- storage.mode(x) x.tmp <- .xts(cdata, .index(x)[i], tclass(x), tzone(x), dimnames = list(NULL, colnames(x))) return(x.tmp) } else { if(USE_EXTRACT) { return(.Call(C_extract_col, x, as.integer(1:nc), drop, as.integer(i[1]), as.integer(i[length(i)]))) } else { return(.Call(C__do_subset_xts, x, as.integer(i), as.integer(1:nc), drop)) } } } else # test for negative subscripting in j if (is.numeric(j)) { if(min(j,na.rm=TRUE) < 0) { if(max(j,na.rm=TRUE) > 0) stop('only zeros may be mixed with negative subscripts') j <- (1:nc)[j] } if(max(j,na.rm=TRUE) > nc) stop('subscript out of bounds') } else if(is.logical(j)) { if(length(j) == 1) { j <- (1:nc)[rep(j, nc)] } else if (length(j) > nc) { stop("(subscript) logical subscript too long") } else j <- (1:nc)[j] } else if(is.character(j)) { j <- match(j, colnames(x), nomatch=0L) # ensure all j are in colnames(x) if(any(j==0)) stop("subscript out of bounds") } j0 <- which(!as.logical(j)) if(length(j0)) j <- j[-j0] if(length(j) == 0 || (length(j)==1 && (is.na(j) || j==0))) { if(missing(i)) i <- seq_len(nr) output <- .xts(coredata(x)[i,j,drop=FALSE], .index(x)[i], tclass(x), tzone(x), class = class(x)) xtsAttributes(output) <- xtsAttributes(x) return(output) } if(missing(i)) return(.Call(C_extract_col, x, as.integer(j), drop, 1, nr)) if(USE_EXTRACT) { return(.Call(C_extract_col, x, as.integer(j), drop, as.integer(i[1]), as.integer(i[length(i)]))) } else return(.Call(C__do_subset_xts, x, as.integer(i), as.integer(j), drop)) } # Replacement method for xts objects # # Adapted from [.xts code, making use of NextGeneric as # replacement function in R already preserves all attributes # and index value is left untouched `[<-.xts` <- #`xtsreplacement` <- function(x, i, j, value) { if (!missing(i)) { i <- x[i, which.i=TRUE] } .Class <- "matrix" NextMethod(.Generic) } # Convert a character or time type to POSIXct for use by subsetting and window # We make this an explicit function so that subset and window will convert dates consistently. .toPOSIXct <- function(i, tz) { if(inherits(i, "POSIXct")) { dts <- i } else if(is.character(i)) { dts <- as.POSIXct(as.character(i),tz=tz) # Need as.character because i could be AsIs from I(dates) } else if (timeBased(i)) { if(inherits(i, "Date")) { dts <- as.POSIXct(as.character(i),tz=tz) } else { # force all other time classes to be POSIXct dts <- as.POSIXct(i,tz=tz) } } else { stop("invalid time / time based class") } dts } # find the rows of index. where the date is in [start, end]. # use binary search. # convention is that NA start or end returns empty index_bsearch <- function(index., start, end) { if(!is.null(start) && is.na(start)) return(NULL) if(!is.null(end) && is.na(end)) return(NULL) if(is.null(start)) { si <- 1 } else { si <- binsearch(start, index., TRUE) } if(is.null(end)) { ei <- length(index.) } else { ei <- binsearch(end, index., FALSE) } if(is.na(si) || is.na(ei) || si > ei) return(NULL) firstlast <- seq.int(si, ei) firstlast } # window function for xts series # return indexes in x matching dates window_idx <- function(x, index. = NULL, start = NULL, end = NULL) { if(is.null(index.)) { usr_idx <- FALSE index. <- .index(x) } else { # Translate the user index to the xts index usr_idx <- TRUE idx <- .index(x) index. <- .toPOSIXct(index., tzone(x)) index. <- unclass(index.) index. <- index.[!is.na(index.)] if(is.unsorted(index.)) { # index. must be sorted for index_bsearch # N.B!! This forces the returned values to be in ascending time order, regardless of the ordering in index, as is done in subset.xts. index. <- sort(index.) } # Fast search on index., faster than binsearch if index. is sorted (see findInterval) base_idx <- findInterval(index., idx) base_idx <- pmax(base_idx, 1L) # Only include indexes where we have an exact match in the xts series match <- idx[base_idx] == index. base_idx <- base_idx[match] index. <- index.[match] index. <- .POSIXct(index., tz = tzone(x)) if(length(base_idx) < 1) return(x[NULL,]) } if(!is.null(start)) { start <- .toPOSIXct(start, tzone(x)) } if(!is.null(end)) { end <- .toPOSIXct(end, tzone(x)) } firstlast <- index_bsearch(index., start, end) if(usr_idx && !is.null(firstlast)) { # Translate from user .index to xts index # We get back upper bound of index as per findInterval tmp <- base_idx[firstlast] res <- .Call(C_fill_window_dups_rev, tmp, .index(x)) firstlast <- rev(res) } firstlast } # window function for xts series, use binary search to be faster than base zoo function # index. defaults to the xts time index. If you use something else, it must conform to the standard for order.by in the xts constructor. # that is, index. must be time based, window.xts <- function(x, index. = NULL, start = NULL, end = NULL, ...) { # scalar NA values are treated as NULL if (isTRUE(is.na(start))) start <- NULL if (isTRUE(is.na(end))) end <- NULL if(is.null(start) && is.null(end) && is.null(index.)) return(x) # dispatch to window.zoo() for yearmon and yearqtr if(any(tclass(x) %in% c("yearmon", "yearqtr"))) { return(NextMethod(.Generic)) } firstlast <- window_idx(x, index., start, end) # firstlast may be NULL .Call(C__do_subset_xts, x, as.integer(firstlast), seq.int(1, ncol(x)), drop = FALSE) } # Declare binsearch to call the routine in binsearch.c binsearch <- function(key, vec, start=TRUE) { # Convert to double if both are not integer if (storage.mode(key) != storage.mode(vec)) { storage.mode(key) <- storage.mode(vec) <- "double" } .Call(C_binsearch, key, vec, start) } # Unit tests for the above code may be found in runit.xts.methods.R xts/R/start.R0000644000176200001440000000171414522244665012566 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `start.xts` <- function(x, ...) { index(x[1,]) } `end.xts` <- function(x, ...) { if(length(x)==0) { index(x[length(.index(x)),]) } else index(x[NROW(x),]) } xts/R/adj.time.R0000644000176200001440000000253014522244662013116 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . adj.time <- function(x, ...) { tr <- match.call(expand.dots=FALSE)$... if(length(tr) < 1) return(x) oClass <- class(x) x <- as.POSIXlt(x) ntime <- as.environment(unclass(x)) lapply(tr, function(T) { assign(all.vars(T), with(x, eval(T)), envir=ntime) }) x <- structure(list( sec=ntime$sec, min=ntime$min, hour=ntime$hour, mday=ntime$mday, month=ntime$mon, year=ntime$year, wday=ntime$wday, yday=ntime$yday,isdst=ntime$isdst), tzone=attr(x,"tzone"), class=c("POSIXlt","POSIXt")) do.call(paste('as',oClass[1],sep='.'), list(x)) } xts/R/timeBasedRange.R0000644000176200001440000000213614522244665014302 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `timeBasedRange` <- function(x, ...) { # convert unquoted time range to if (!is.character(x)) x <- deparse(match.call()$x) # determine start and end points tblist <- timeBasedSeq(x,NULL) # if(!is.null(tblist$length.out)) # return(tblist$from) c(as.numeric(tblist$from), as.numeric(tblist$to)) } xts/R/tclass.R0000644000176200001440000000665114525744640012730 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `convertIndex` <- function(x,value) { tclass(x) <- value x } tclass <- function(x, ...) { UseMethod('tclass') } tclass.default <- function(x, ...) { attr(x, "tclass") } tclass.xts <- function(x, ...) { tclass <- attr(attr(x, "index"), "tclass") # For xts objects created pre-0.10.3 if (is.null(tclass)) { # no tclass on the index sq_tclass <- sQuote("tclass") sq_both <- paste(sq_tclass, "or", sQuote(".indexCLASS")) warn_msg <- paste0("index does not have a ", sq_tclass, " attribute") tclass <- attr(x, "tclass") if (is.null(tclass)) { # no tclass on the xts object, look for .indexCLASS tclass <- attr(x, ".indexCLASS") } if (is.null(tclass)) { # no .indexCLASS on the xts object tc <- c("POSIXct", "POSIXt") warn_msg <- paste0(warn_msg, "\n and xts object does not have a ", sq_both, " attribute\n", " returning ", dQuote(tc)) warning(warn_msg) return(tc) } sym <- deparse(substitute(x)) warning(warn_msg, "\n use ", sym, " <- xts:::.update_index_attributes(", sym, ") to update the object") } return(tclass) } `tclass<-` <- function(x,value) { UseMethod('tclass<-') } `tclass<-.default` <- function(x, value) { if (!is.null(value)) { value <- as.character(value) } attr(x, "tclass") <- value x } indexClass <- function(x) { .Deprecated("tclass", "xts") tclass(x) } `indexClass<-` <- function(x, value) { .Deprecated("tclass<-", "xts") `tclass<-`(x, value) } `tclass<-.xts` <- function(x, value) { if(!is.character(value) && length(value) != 1) stop('improperly specified value for tclass') # remove 'POSIXt' from value, to prevent tclass(x) <- 'POSIXt' value <- value[!value %in% "POSIXt"] if(length(value)==0L) stop(paste('unsupported',sQuote('tclass'),'indexing type: POSIXt')) if(!value[1] %in% c('dates','chron','POSIXlt','POSIXct','Date','timeDate','yearmon','yearqtr','xtime') ) stop(paste('unsupported',sQuote('tclass'),'indexing type:',as.character(value[[1]]))) # Add 'POSIXt' virtual class if(value %in% c('POSIXlt','POSIXct')) value <- c(value,'POSIXt') # all index related meta-data will be stored in the index # as attributes if(isClassWithoutTZ(value)) { attr(attr(x,'index'), 'tzone') <- 'UTC' } attr(attr(x,'index'), 'tclass') <- value x_has_tz <- !isClassWithoutTZ(x) if(x_has_tz && isClassWithoutTZ(value)) { # update index values to midnight UTC (this also changes the tzone) index(x) <- index(x) } # Remove class attrs (object created before 0.10-3) attr(x, ".indexCLASS") <- NULL attr(x, "tclass") <- NULL x } xts/R/as.numeric.R0000644000176200001440000001106314522244662013470 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.numeric.xts <- function(x, drop=TRUE, ...) { if(drop) return(as.numeric(coredata(x))) .xts(matrix(as.numeric(coredata(x)),ncol=NCOL(x)), .index(x)) } as.xts.numeric <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...) { # jmu if(missing(order.by)) { if(is.null(names(x))) stop("order.by must be either 'names()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(names(x))) } xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='numeric', ...) return(xx) } re.numeric <- function(x,...) { if( !is.null(dim(x))) return(as.matrix(x)) # jmu y <- as.numeric(x,...) names(y) <- index(x) return(y) } as.integer.xts <- function(x, drop=TRUE, ...) { if(drop) return(as.integer(coredata(x))) .xts(matrix(as.integer(coredata(x)),ncol=NCOL(x)), .index(x)) } as.xts.integer <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...) { # jmu if(missing(order.by)) { if(is.null(names(x))) stop("order.by must be either 'names()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(names(x))) } xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='integer', ...) return(xx) } re.integer <- function(x,...) { if( !is.null(dim(x))) return(as.matrix(x)) # jmu y <- as.integer(x,...) names(y) <- index(x) return(y) } as.double.xts <- function(x, drop=TRUE, ...) { if(drop) return(as.double(coredata(x))) .xts(matrix(as.double(coredata(x)),ncol=NCOL(x)), .index(x)) } as.xts.double <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...) { # jmu if(missing(order.by)) { if(is.null(names(x))) stop("order.by must be either 'names()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(names(x))) } xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='double', ...) return(xx) } re.double <- function(x,...) { if( !is.null(dim(x))) return(as.matrix(x)) # jmu y <- as.double(x,...) names(y) <- index(x) return(y) } as.complex.xts <- function(x, drop=TRUE, ...) { if(drop) return(as.complex(coredata(x))) .xts(matrix(as.complex(coredata(x)),ncol=NCOL(x)), .index(x)) } as.xts.complex <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...) { # jmu if(missing(order.by)) { if(is.null(names(x))) stop("order.by must be either 'names()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(names(x))) } xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='complex', ...) return(xx) } re.complex <- function(x,...) { if( !is.null(dim(x))) return(as.matrix(x)) # jmu y <- as.complex(x,...) names(y) <- index(x) return(y) } as.logical.xts <- function(x, drop=TRUE, ...) { if(drop) return(as.logical(coredata(x))) .xts(matrix(as.logical(coredata(x)),ncol=NCOL(x)), .index(x)) } as.xts.logical <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...) { # jmu if(missing(order.by)) { if(is.null(names(x))) stop("order.by must be either 'names()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(names(x))) } xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='logical', ...) return(xx) } re.logical <- function(x,...) { if( !is.null(dim(x))) return(as.matrix(x)) # jmu y <- as.logical(x,...) names(y) <- index(x) return(y) } xts/R/axTicksByTime.R0000644000176200001440000000560014522244662014144 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . axTicksByTime <- function(x, ticks.on = "auto", k = 1, labels = TRUE, format.labels = TRUE, ends = TRUE, gt = 2, lt = 30) { # if a vector of times/dates, convert to dummy xts object if (timeBased(x)) { x <- xts(rep(1, length(x)), x) } ticks.on <- ticks.on[1L] # special-case for "secs" and "mins" if (ticks.on == "secs" || ticks.on == "mins") { ticks.on <- substr(ticks.on, 1L, 3L) } tick.opts <- c("years", "quarters", "months", "weeks", "days", "hours", "minutes", "seconds") ticks.on <- match.arg(ticks.on, c("auto", tick.opts)) if (ticks.on == "auto") { tick.k.opts <- c(10, 5, 2, 1, 3, 6, 1, 1, 1, 4, 2, 1, 30, 15, 1, 1) tick.opts <- rep(tick.opts, c(4, 1, 2, 1, 1, 3, 3, 1)) is <- structure(rep(0, length(tick.opts)), .Names = tick.opts) for (i in 1:length(tick.opts)) { ep <- endpoints(x, tick.opts[i], tick.k.opts[i]) is[i] <- length(ep) - 1 if (is[i] > lt) { break } } loc <- rev(which(is > gt & is < lt))[1L] cl <- tick.opts[loc] ck <- tick.k.opts[loc] } else { cl <- ticks.on[1L] ck <- k } if (is.null(cl) || is.na(cl) || is.na(ck)) { ep <- c(0, NROW(x)) } else { ep <- endpoints(x, cl, ck) } if (ends) { ep <- ep + c(rep(1, length(ep) - 1), 0) } if (labels) { if (is.logical(format.labels) || is.character(format.labels)) { # format by platform... unix <- (.Platform$OS.type == "unix") # ...and level of time detail fmt <- switch(periodicity(x)$scale, weekly = , daily = if (unix) "%b %d%n%Y" else "%b %d %Y", minute = , hourly = if (unix) "%b %d%n%H:%M" else "%b %d %H:%M", seconds = if (unix) "%b %d%n%H:%M:%S" else "%b %d %H:%M:%S", if (unix) "%n%b%n%Y" else "%b %Y") # special case yearqtr index if (inherits(index(x), "yearqtr")) { fmt <- "%Y-Q%q" } if (is.character(format.labels)) { fmt <- format.labels } names(ep) <- format(index(x)[ep], fmt) } else { names(ep) <- as.character(index(x)[ep]) } } ep } xts/R/rollapply.xts.R0000644000176200001440000001457714522244665014277 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . rollapply.xts <- function(data, width, FUN, ..., by=1, by.column=TRUE, fill=if(na.pad) NA, na.pad=TRUE, partial=TRUE, align=c("right","center","left")) { if (!missing(na.pad)) { warning("na.pad argument is deprecated") } if (!missing(partial)) { warning("partial argument is not currently supported") } data <- try.xts(data) # jmu: is this necessary? # Code taken/adapted from rollapply.zoo from the 'zoo' package # 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 <- 1:k # if(!ascending) cols <- rev(cols) # matrix(s + rep(cols, rep(lens,k))-1, lens) # } # xts doesn't currently have these functions # 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))) nr <- NROW(data) nc <- NCOL(data) 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 }) idx <- index(data) tt <- index(data)[seq((width-n1), (nr-n1), by)] #tt <- idx[seq((width-n1), (nr-n1), 1)] ## evaluate FUN only on coredata(data) #data <- coredata(data) FUN <- match.fun(FUN) ind <- as.matrix(seq.int(width,nr,by)) #e <- embedi(nr, width, by, ascending) if( nc==1 ) { #xx <- apply(e, 1, function(i) FUN(data[i,],...)) #xx <- sapply(1:NROW(e), function(i) FUN(data[e[i,],],...)) ##xx <- sapply(ind, function(i) FUN(data[(i-width+1):i,],...)) xx <- sapply(ind, function(i) FUN(.subset_xts(data,(i-width+1):i),...)) if(!is.null(dim(xx))) xx <- t(xx) res <- xts(xx, tt, if (by == 1) attr(data, "frequency")) } else if( by.column ) { res <- xts( sapply( 1:NCOL(data), function(j) #apply(e, 1, function(i) FUN(data[i,j],...)) ), #apply(ind, 1, function(i) FUN(data[(i-width+1):i,j],...)) ), apply(ind, 1, function(i) FUN(.subset_xts(data,(i-width+1):i,j),...)) ), tt, if (by == 1) attr(data, "frequency") ) } else { #xx <- apply(e, 1, function(i) FUN(data[i,],...)) ##xx <- apply(ind, 1, function(i) FUN(data[(i-width+1):i,],...)) xx <- apply(ind, 1, function(i) FUN(.subset_xts(data,(i-width+1):i),...)) if(!is.null(dim(xx))) xx <- t(xx) res <- xts(xx, tt, if (by == 1) attr(data, "frequency")) } ix <- index(data) %in% index(res) tmp <- merge(res, xts(,idx, attr(data, "frequency"))) if(is.null(colnames(res))) { # remove dimnames (xts objects don't have rownames) dimnames(tmp) <- NULL } res <- na.fill(tmp, fill, ix) if( by.column && !is.null(dim(data)) ) { colnames(res) <- colnames(data) } return(res) } rollsum.xts <- function (x, k, fill=if(na.pad) NA, na.pad=TRUE, align=c("right", "center", "left"), ...) { ## FIXME: align and fill are not respected! # from rollapply.xts; is this necessary? x <- try.xts(x) # from rollmean.zoo if (!missing(na.pad)) warning("na.pad is deprecated. Use fill.") # process alignment align <- match.arg(align) #n1 <- switch(align, # "left" = { k - 1 }, # "center" = { floor(k/2) }, # "right" = { 0 }) #ix <- index(x)[seq((k-n1), (nrow(x)-n1), 1)] res <- .Call(C_roll_sum, x, k) res } rollmean.xts <- function (x, k, fill=if(na.pad) NA, na.pad=TRUE, align=c("right", "center", "left"), ...) { rollsum.xts(x=x, k=k, fill=fill, align=align, ...) / k } rollmax.xts <- function (x, k, fill=if(na.pad) NA, na.pad=TRUE, align=c("right", "center", "left"), ...) { ## FIXME: align and fill are not respected! # from rollapply.xts; is this necessary? x <- try.xts(x) # from rollmean.zoo if (!missing(na.pad)) warning("na.pad is deprecated. Use fill.") # process alignment align <- match.arg(align) #n1 <- switch(align, # "left" = { k - 1 }, # "center" = { floor(k/2) }, # "right" = { 0 }) #ix <- index(x)[seq((k-n1), (nrow(x)-n1), 1)] res <- .Call(C_roll_max, x, k) res } rollmin.xts <- function (x, k, fill=if(na.pad) NA, na.pad=TRUE, align=c("right", "center", "left"), ...) { ## FIXME: align and fill are not respected! # from rollapply.xts; is this necessary? x <- try.xts(x) # from rollmean.zoo if (!missing(na.pad)) warning("na.pad is deprecated. Use fill.") # process alignment align <- match.arg(align) #n1 <- switch(align, # "left" = { k - 1 }, # "center" = { floor(k/2) }, # "right" = { 0 }) #ix <- index(x)[seq((k-n1), (nrow(x)-n1), 1)] res <- .Call(C_roll_min, x, k) res } rollcov.xts <- function (x, y, k, fill=if(na.pad) NA, na.pad=TRUE, align=c("right", "center", "left"), sample=TRUE, ...) { ## FIXME: align and fill are not respected! # from rollapply.xts; is this necessary? x <- try.xts(x) y <- try.xts(y) # from rollmean.zoo if (!missing(na.pad)) warning("na.pad is deprecated. Use fill.") # process alignment align <- match.arg(align) #n1 <- switch(align, # "left" = { k - 1 }, # "center" = { floor(k/2) }, # "right" = { 0 }) #ix <- index(x)[seq((k-n1), (nrow(x)-n1), 1)] res <- .Call(C_roll_cov, x, y, k, sample) res } xts/R/Math.xts.R0000644000176200001440000000340014522244662013126 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # This code adapted from Ops.zoo.R cumsum.xts <- function(x) { if( NCOL(x) == 1 ) { x[] <- cumsum(coredata(x)) } else x[] <- apply(coredata(x), 2, function(y) cumsum(y)) x } cumprod.xts <- function(x) { if( NCOL(x) == 1 ) { x[] <- cumprod(coredata(x)) } else x[] <- apply(coredata(x), 2, function(y) cumprod(y)) x } cummin.xts <- function(x) { if( NCOL(x) == 1 ) { x[] <- cummin(coredata(x)) } else x[] <- apply(coredata(x), 2, function(y) cummin(y)) x } cummax.xts <- function(x) { if( NCOL(x) == 1 ) { x[] <- cummax(coredata(x)) } else x[] <- apply(coredata(x), 2, function(y) cummax(y)) x } mean.xts <- function(x,...) { if(is.vector(x) ||is.null(ncol(x)) || ncol(x)==1){ x<-as.numeric(x) mean(x,...) } else apply(x,2,mean.xts,...) } sd.xts <- function(x,na.rm=FALSE) { if(is.vector(x) || is.null(ncol(x)) || ncol(x)==1){ x<-as.numeric(x) sd(x,na.rm=na.rm) } else apply(x,2,sd,na.rm=na.rm) }xts/R/fillIndex.R0000644000176200001440000000176414522244662013351 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `fillIndex` <- function(x) { p <- periodicity(x) xx <- xts(matrix(rep(NA,NCOL(x)),nrow=1), seq(start(x),end(x),by=p$units)) xx[index(xx) %in% index(x)] <- x colnames(xx) <- colnames(x) xx } xts/R/data.frame.R0000644000176200001440000000446514522244662013436 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # functions to handle data.frame <--> xts conversions `re.data.frame` <- function(x,...) { data.frame(x,...) } `as.xts.data.frame` <- function(x, order.by, dateFormat = "POSIXct", frequency = NULL, ..., .RECLASS = FALSE) { # Should allow 'order.by' to be a vector of dates or a scaler # representing the column number to use. if(missing(order.by)) { order_by_ <- try({ coerce.rownames <- paste("as", dateFormat, sep = ".") do.call(coerce.rownames, list(rownames(x))) }, silent = TRUE) if(inherits(order_by_, "try-error")) { # parsing row names failed, so look for a time-based column time.based.col <- vapply(x, is.timeBased, logical(1)) if(any(time.based.col)) { # use the first time-based column which.col <- which.max(time.based.col) order_by_ <- x[[which.col]] x <- x[, -which.col, drop = FALSE] } else { stop("could not convert row names to a date-time and could not find a time-based column") } } } else { order_by_ <- order.by } if(.RECLASS) { xx <- xts(x, order.by=order_by_, frequency=frequency, .CLASS='data.frame', ...) } else { xx <- xts(x, order.by=order_by_, frequency=frequency, ...) } xx } `as.data.frame.xts` <- function(x,row.names=NULL,optional=FALSE,...) { if(missing(row.names)) row.names <- as.character(index(x)) as.data.frame(coredata(x),row.names,optional,...) } xts/R/first.R0000644000176200001440000001143614522244662012557 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `first` <- function(x,...) { UseMethod("first") } `first.default` <- function(x,n=1,keep=FALSE,...) { if(length(x) == 0) return(x) if(is.character(n)) { xx <- try.xts(x, error=FALSE) if(is.xts(xx)) { xx <- first.xts(x, n=n, keep=keep, ...) return(reclass(xx)) } } if(is.null(dim(x))) { if(n > 0) { sub <- seq_len(min(n, length(x))) xx <- x[sub] if(keep) xx <- structure(xx,keep=x[(-(-n)+1):NROW(x)]) xx } else if(n < 0) { sub <- seq.int(to = length(x), length.out = max(length(x)-(-n), 0L)) xx <- x[sub] if(keep) xx <- structure(xx,keep=x[1:(-n)]) xx } else { xx <- x[0] if(keep) xx <- structure(xx,keep=x[0]) xx } } else { if(n > 0) { sub <- seq_len(min(n, NROW(x))) xx <- x[sub,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[(-(-n)+1):NROW(x),]) xx } else if(n < 0) { sub <- seq.int(to = NROW(x), length.out = max(NROW(x)-(-n), 0L)) xx <- x[sub,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[1:(-n),]) xx } else { xx <- x[0,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[0,]) xx } } } `first.xts` <- function(x,n=1,keep=FALSE,...) { if(length(x) == 0) return(x) if(is.character(n)) { # n period set np <- strsplit(n," ",fixed=TRUE)[[1]] if(length(np) > 2 || length(np) < 1) stop(paste("incorrectly specified",sQuote("n"),sep=" ")) # series periodicity sp <- periodicity(x) # requested periodicity$units sp.units <- sp[["units"]] rpu <- np[length(np)] rpf <- ifelse(length(np) > 1, as.numeric(np[1]), 1) if(rpu == sp.units) { n <- rpf } else { # if singular - add an s to make it work if(substr(rpu,length(strsplit(rpu,'')[[1]]),length(strsplit(rpu,'')[[1]])) != 's') rpu <- paste(rpu,'s',sep='') u.list <- list(secs=4,seconds=4,mins=3,minutes=3,hours=2,days=1, weeks=1,months=1,quarters=1,years=1) dt.options <- c('seconds','secs','minutes','mins','hours','days', 'weeks','months','quarters','years') if(!rpu %in% dt.options) stop(paste("n must be numeric or use",paste(dt.options,collapse=','))) dt <- dt.options[pmatch(rpu,dt.options)] if(u.list[[dt]] > u.list[[sp.units]]) { # req is for higher freq data period e.g. 100 mins of daily data stop(paste("At present, without some sort of magic, it isn't possible", "to resolve",rpu,"from",sp$scale,"data")) } ep <- endpoints(x,dt) if(rpf > length(ep)-1) { rpf <- length(ep)-1 warning("requested length is greater than original") } if(rpf > 0) { n <- ep[rpf+1] if(is.null(dim(x))) { xx <- x[1:n] } else { xx <- x[1:n,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[(ep[-(-rpf)+1]+1):NROW(x)]) return(xx) } else if(rpf < 0) { n <- ep[-rpf+1]+1 if(is.null(dim(x))) { xx <- x[n:NROW(x)] } else { xx <- x[n:NROW(x),,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[1:(ep[-rpf+1])]) return(xx) } else { if(is.null(dim(x))) { xx <- x[0] } else { xx <- x[0,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[0]) return(xx) } } } if(length(n) != 1) stop("n must be of length 1") if(n > 0) { n <- min(n, NROW(x)) if(is.null(dim(x))) { xx <- x[1:n] } else { xx <- x[1:n,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[(-(-n)+1):NROW(x)]) xx } else if(n < 0) { if(abs(n) >= NROW(x)) return(x[0]) if(is.null(dim(x))) { xx <- x[(-n+1):NROW(x)] } else { xx <- x[(-n+1):NROW(x),,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[1:(-n)]) xx } else { if(is.null(dim(x))) { xx <- x[0] } else { xx <- x[0,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[0]) xx } } xts/R/ts.R0000644000176200001440000000767014522244665012066 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # methods for handling ts <--> xts #`re.ts2` <- #function(x,...) { # # attempt to provide a more robust reclass 'ts' method # na.replace <- function(x) { # na.removed <- attr(x,'na.action') # if(class(na.removed) != 'omit') return() # nrows <- NROW(x) # xx <- vector('numeric',length=(nrows+length(na.removed))) # xx[ na.removed,] <- NA # xx[-na.removed] <- x # xx # } #} `re.ts` <- function(x,...) { # major issue with quick reclass. Basically fails on data < 1970... #tsp.attr <- attr(x,'.tsp') #freq.attr <- attr(x,'.frequency') #xtsAttributes(x) <- NULL #ts(coredata(x), start=tsp.attr[1],frequency=freq.attr) dim <- attr(x, 'dim') if(!is.null(dim) && dim[2]==1) { attr(x,'dim') <- attr(x, 'dimnames') <- NULL } as.ts(x) } `as.xts.ts` <- function(x,dateFormat,...,.RECLASS=FALSE) { x.mat <- structure(as.matrix(x),dimnames=dimnames(x)) colnames(x.mat) <- colnames(x) # quick hueristic - if numeric index is larger than one # full day of seconds (60*60*24) than use POSIXct, otherwise # assume we are counting my days, not seconds, and use Date -jar # # I am sure this can be improved upon, but for now it is effective # in most circumstances. Will break if frequency or time is from 1 # not _break_ but be less useful # a bigger question is _should_ it throw an error if it can't guess, # or should the user simply beware. if(missing(dateFormat)) { if(frequency(x) == 1) { # assume yearly series: Date yr <- tsp(x)[1] %/% 1 mo <- tsp(x)[1] %% 1 if(mo %% (1/12) != 0 || yr > 3000) { # something finer than year.month is specified - can't reliable convert dateFormat <- ifelse(max(time(x)) > 86400,'POSIXct','Date') order.by <- do.call(paste('as',dateFormat,sep='.'), list(as.numeric(time(x)),origin='1970-01-01',...)) } else { mo <- ifelse(length(mo) < 1, 1,floor(mo * 12)+1) from <- as.Date(firstof(yr,mo),origin='1970-01-01') order.by <- seq.Date(from,length.out=length(time(x)),by='year') } } else if(frequency(x) == 4) { # quarterly series: yearqtr order.by <- as.yearqtr(time(x)) } else if(frequency(x) == 12) { # monthly series: yearmon order.by <- as.yearmon(time(x)) } else stop('could not convert index to appropriate type') } else { order.by <- do.call(paste('as',dateFormat,sep='.'), list(as.numeric(time(x)),...)) } if(.RECLASS) { xx <- xts(x.mat, order.by=order.by, frequency=frequency(x), .CLASS='ts', .CLASSnames=c('frequency'), .tsp=tsp(x), # .frequency=frequency(x), ...) } else { xx <- xts(x.mat, order.by=order.by, frequency=frequency(x), ...) } attr(xx, 'tsp') <- NULL xx } `as.ts.xts` <- function(x,...) { #if(attr(x,'.CLASS')=='ts') return(re.ts(x,...)) TSP <- attr(x, '.tsp') attr(x, '.tsp') <- NULL x <- ts(coredata(x), frequency=frequency(x), ...) if(!is.null(dim(x)) && dim(x)[2]==1) dim(x) <- NULL if(!is.null(TSP)) tsp(x) <- TSP x } xts/R/matrix.R0000644000176200001440000000472414522244664012740 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # functions for matrix <--> xts conversions `as.matrix.xts` <- function(x, ...) { # This function follows the pattern of as.matrix.zoo() cd <- coredata(x) y <- as.matrix(cd, ...) if (length(cd) == 0) { dim(y) <- c(0, 0) } # colnames if (length(y) > 0) { cnx <- colnames(x) if (length(cnx) > 0) { colnames(y) <- cnx } else { cn <- deparse(substitute(x), width.cutoff = 100, nlines = 1) if (NCOL(x) == 1) { colnames(y) <- cn } else { colnames(y) <- paste(cn, 1:ncol(x), sep = ".") } } } else if (nrow(y) != length(.index(x))) { dim(y) <- c(length(.index(x)), 0) } # rownames if (!is.null(y) && nrow(y) > 0 && is.null(rownames(y))) { rownames(y) <- as.character(index(x)) } y } `re.matrix` <- function(x,...) { as.matrix(x,...) } `as.xts.matrix` <- function(x,order.by,dateFormat="POSIXct",frequency=NULL,...,.RECLASS=FALSE) { # Should allow 'order.by' to be a vector of dates or a scaler # representing the column number to use. if(missing(order.by)) { # The 'index' of zoo objects is set to 'rownames' when converted with 'as.matrix', # but it is of class 'Date', not 'POSIXct'... - jmu if(is.null(rownames(x))) stop("order.by must be either 'rownames()' or otherwise specified") else # added '...' args to allow for tz specification order.by <- do.call(paste('as',dateFormat,sep='.'),list(rownames(x))) } if(.RECLASS) { xx <- xts(x, order.by=order.by, frequency=frequency, .CLASS='matrix', ...) } else { xx <- xts(x, order.by=order.by, frequency=frequency, ...) } xx } xts/R/yearmon.R0000644000176200001440000000164414522244665013105 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.xts.yearmon <- function(x, ...) { xts(x=NULL, order.by=x) } as.xts.yearqtr <- function(x, ...) { xts(x=NULL, order.by=x) } xts/R/tzone.R0000644000176200001440000001042414525744640012567 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . indexTZ <- function(x, ...) { .Deprecated("tzone", "xts") tzone(x, ...) } tzone <- function(x, ...) { UseMethod("tzone") } `indexTZ<-` <- function(x, value) { .Deprecated("tzone<-", "xts") `tzone<-`(x, value) } `tzone<-` <- function(x, value) { UseMethod("tzone<-") } `tzone<-.xts` <- function(x, value) { if (is.null(value)) { value <- "" } tzone <- as.character(value) attr(attr(x, "index"), "tzone") <- tzone # Remove tz attrs (object created before 0.10-3) attr(x, ".indexTZ") <- NULL attr(x, "tzone") <- NULL x } tzone.default <- function(x, ...) { attr(x, "tzone") } `tzone<-.default` <- function(x, value) { if (!is.null(value)) { value <- as.character(value) } attr(x, "tzone") <- value x } tzone.xts <- function(x, ...) { tzone <- attr(attr(x, "index"), "tzone") # For xts objects created pre-0.10.3 if (is.null(tzone)) { # no tzone on the index sq_tzone <- sQuote("tozne") sq_both <- paste(sq_tzone, "or", sQuote(".indexTZ")) warn_msg <- paste0("index does not have a ", sq_tzone, " attribute") tzone <- attr(x, "tzone") if (is.null(tzone)) { # no tzone on the xts object, look for .indexTZ tzone <- attr(x, ".indexTZ") } if (is.null(tzone)) { # no .indexTZ on the xts object tzone <- "" warn_msg <- paste0(warn_msg, "\n and xts object does not have a ", sq_both, " attribute\n", " returning ", dQuote(tzone)) warning(warn_msg) return(tzone) } sym <- deparse(substitute(x)) warning(warn_msg, "\n use ", sym, " <- xts:::.update_index_attributes(", sym, ") to update the object") } return(tzone) } isClassWithoutTZ <- function(tclass, object = NULL) { .classesWithoutTZ <- c("chron","dates","times","Date","yearmon","yearqtr") has_no_tz <- FALSE if (is.null(object)) { has_no_tz <- any(tclass %in% .classesWithoutTZ) } else { has_no_tz <- inherits(object, .classesWithoutTZ) } return(has_no_tz) } isUTC <- function(tz = NULL) { if (is.null(tz)) { tz <- Sys.timezone() } switch(tz, "UTC" = , "GMT" = , "Etc/UTC" = , "Etc/GMT" = , "GMT-0" = , "GMT+0" = , "GMT0" = TRUE, FALSE) } check.TZ <- function(x, ...) { check <- getOption("xts_check_TZ") if (!is.null(check) && !check) { return() } x_tz <- tzone(x) x_tclass <- tclass(x) if (isClassWithoutTZ(x_tclass)) { # warn if tzone is not UTC or GMT (GMT is not technically correct, since # it *is* a timezone, but it should work for all practical purposes) if (!isUTC(x_tz)) { warning(paste0("object index class (", paste(x_tclass, collapse = ", "), ") does not support timezones.\nExpected 'UTC' timezone, but tzone is ", sQuote(x_tz)), call. = FALSE) } else { return() } } x_tz_str <- as.character(x_tz) sys_tz <- Sys.getenv("TZ") if (!is.null(x_tz) && x_tz_str != "" && !identical(sys_tz, x_tz_str)) { msg <- paste0("object timezone ('", x_tz, "') is different ", "from system timezone ('", sys_tz, "')") if (is.null(check)) { # xts_check_TZ is NULL by default # set to TRUE after messaging user how to disable the warning msg <- paste0(msg, "\n NOTE: set 'options(xts_check_TZ = FALSE)' ", "to disable this warning\n", " This note is displayed once per session") options(xts_check_TZ = TRUE) } warning(msg, call. = FALSE) } } xts/R/bind.R0000644000176200001440000000600714522244662012342 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . cbind.xts <- function(..., all=TRUE, fill=NA, suffixes=NULL) { # mc <- match.call(call=sys.call(sys.parent())) # mc[[1]] <- as.name("merge.xts") # eval(mc) merge.xts(..., all=all, fill=fill, suffixes=suffixes) } # # convert the call to a list to better manipulate it # mc <- as.list(match.call(call=sys.call(-1))) # # # remove deparse.level arg if called via cbind 'generic' # if(as.character(mc[[1]]) == "cbind") # mc <- mc[-2] # # # check if any default args are missing from the call, # # and add them to the call with the cbind defaults # if(missing(all)) mc <- c(mc,all=all) # if(missing(fill)) mc <- c(mc,fill=fill) # if(missing(suffixes)) mc <- c(mc,suffixes=suffixes) # # # replace the call to cbind.xts with merge.xts # mc[[1]] <- as.name('merge.xts') # # # convert the list into a call and evaluate it # mc <- as.call(mc) # eval(mc) #} # sc <- sys.call(sys.parent()) # mc <- gsub('cbind|cbind.xts','merge.xts',deparse(match.call(call=sc))) # return(eval(parse(text=mc))) # dots <- mc$... # length.args <- sum(.External("number_of_cols",...,PACKAGE="xts")) # if(is.null(suffixes)) # suffixes <- all.vars(match.call(call=sc), unique=FALSE)[1:length.args] # # if( length(suffixes) != length.args ) { # warning("length of suffixes and does not match number of merged objects") # suffixes <- rep(suffixes, length.out=length.args) # } # # merge.xts(..., all=all, fill=fill, suffixes=suffixes) # # dat <- list(...) # x <- dat[[1]]; dat <- dat[-1] # while( length(dat) > 0 ) { # y <- dat[[1]] # if( length(dat) > 0 ) # dat <- dat[-1] # x <- merge.xts(x, y, all=TRUE, fill=NA, suffixes=NULL, retclass="xts") # } # x #} `c.xts` <- function(...) { .External(C_rbindXts, dup=FALSE, ...) } rbind.xts <- function(..., deparse.level=1) { .External(C_rbindXts, dup=FALSE, ...) } `.rbind.xts` <- function(..., deparse.level=1) { dots <- list(...) if(length(dots) < 2) return(dots[[1]]) x <- dots[[1]] dots <- dots[-1] while( length(dots) > 0 ) { y <- dots[[1]] if( length(dots) > 0) dots <- dots[-1] if(!is.null(colnames(y)) && colnames(x) != colnames(y)) warning('column names differ') x <- .Call(C_do_rbind_xts,x,y,FALSE) } return(x) } xts/R/plot.R0000644000176200001440000014475514540670206012416 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2009-2015 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Ross Bennett and Joshua M. Ulrich # # 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, see . current.xts_chob <- function() invisible(get(".xts_chob",.plotxtsEnv)) # Current design # # There is a main plot object that contains the plot title (and optional # timespan), the x-axis labels and tick marks, and a list of 'panel' objects. # The main plot object contains the objects/functions below. # # * Env: an environment holds all the plot information. # * add_main_header(): add the main plot header # * add_main_xaxis(): add the x-axis labels and ticks to the main plot. # * new_panel(): create a new panel and add it to the plot. # * get_xcoords(): get the x-coordinate values for the plot. # * get_panel(): get a specific panel. # * get_last_action_panel(): get the panel that had the last rendered action. # * new_environment: create a new environment with 'Env' as its parent. # Functions that aren't intended to be called externally: # # * update_panels(): re-calculate the x-axis and y-axis values. # * render_panels(): render all the plot panels. # * x_grid_lines(): plot the x-axis grid lines. # * create_ylim(): create y-axis max/min, handling when max(x) == min(x). # The panel object is composed of the following fields: # # * id: the numeric index of the panel in the plot's list of panels. # * asp: the x/y aspect ratio for the panel (relative vertical size). # * ylim: the ylim of the panel when it was created. # * ylim_render: the ylim of the panel to use when rendering. # * use_fixed_ylim: do not update the panel ylim based on all panels data # * header: the panel title. # * actions: a list of expressions used to render the panel. # * add_action(): a function to add an action to the list. # # The panel has the 'yaxis_expr' expression for rendering the y-axis min/max # values, labels, and grid lines/ticks. It also contains the x-axis grid # expression because we need the y-axis min/max values to know where to draw # the x-axis grid lines on the panel. # Other notes # # Environments created by new_environment() (e.g. the 'lenv') are children of # Env, so expressions evaluated in 'lenv' will look in Env for anything not # found in 'lenv'. # # Visual representation of plot structure # # ____________________________________________________________________________ # / \ # | plot object / window | # | | # | ______________________________________________________________________ | # | / \ | # | | panel #1 | | # | | __________________________________________________________________ | | # | | / \ | | # | | | header frame | | | # | | \__________________________________________________________________/ | | # | | __________________________________________________________________ | | # | | / \ | | # | | | series frame | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | \__________________________________________________________________/ | | # | \______________________________________________________________________/ | # | | # | ______________________________________________________________________ | # | / \ | # | | panel #2 | | # | | __________________________________________________________________ | | # | | / \ | | # | | | header frame | | | # | | \__________________________________________________________________/ | | # | | __________________________________________________________________ | | # | | / \ | | # | | | series frame | | | # | | | | | | # | | | | | | # | | | | | | # | | | | | | # | | \__________________________________________________________________/ | | # | \______________________________________________________________________/ | # | | # \____________________________________________________________________________/ # # Currently not necessary, but potentially very useful: # http://www.fromthebottomoftheheap.net/2011/07/23/passing-non-graphical-parameters-to-graphical-functions-using/ chart.lines <- function(x, type="l", lty=1, lwd=2, lend=1, col=NULL, up.col=NULL, dn.col=NULL, legend.loc=NULL, log=FALSE, ...){ xx <- current.xts_chob() switch(type, h={ # use up.col and dn.col if specified if (!is.null(up.col) && !is.null(dn.col)){ colors <- ifelse(x[,1] < 0, dn.col, up.col) } else { colors <- if (is.null(col)) 1 else col } if (length(colors) < nrow(x[,1])) colors <- colors[1] # x-coordinates for this column xcoords <- xx$get_xcoords(x[,1]) lines(xcoords,x[,1],lwd=2,col=colors,lend=lend,lty=1,type="h",...) }, p=, l=, b=, c=, o=, s=, S=, n={ if(is.null(col)) col <- xx$Env$theme$col if(length(lty) < NCOL(x)) lty <- rep(lty, length.out = NCOL(x)) if(length(lwd) < NCOL(x)) lwd <- rep(lwd, length.out = NCOL(x)) if(length(col) < NCOL(x)) col <- rep(col, length.out = NCOL(x)) for(i in NCOL(x):1) { # x-coordinates for this column xcoords <- xx$get_xcoords(x[,i]) xi <- x[,i] if (isTRUE(log)) xi <- log(xi) lines(xcoords, xi, type=type, lend=lend, col=col[i], lty=lty[i], lwd=lwd[i], ...) } }, { # default case warning(paste(type, "not recognized. Type must be one of 'p', 'l', 'b, 'c', 'o', 'h', 's', 'S', 'n'. plot.xts supports the same types as plot.default, see ?plot for valid arguments for type")) } ) if(!is.null(legend.loc)){ lc <- legend.coords(legend.loc, xx$Env$xlim, range(x, na.rm=TRUE)) legend(x=lc$x, y=lc$y, legend=colnames(x), xjust=lc$xjust, yjust=lc$yjust, fill=col[1:NCOL(x)], bty="n") } } add.par.from.dots <- function(call., ...) { stopifnot(is.call(call.)) # from graphics:::.Pars parnames <- c("xlog","ylog","adj","ann","ask","bg","bty","cex","cex.axis", "cex.lab","cex.main","cex.sub","cin","col","col.axis","col.lab", "col.main","col.sub","cra","crt","csi","cxy","din","err", "family", "fg","fig","fin","font","font.axis","font.lab", "font.main","font.sub","lab","las","lend","lheight","ljoin", "lmitre","lty","lwd","mai","mar","mex","mfcol","mfg","mfrow", "mgp","mkh","new","oma","omd","omi","page","pch","pin","plt", "ps","pty","smo","srt","tck","tcl","usr","xaxp","xaxs","xaxt", "xpd","yaxp","yaxs","yaxt","ylbias") dots <- list(...) argnames <- names(dots) pm <- match(argnames, parnames, nomatch = 0L) call.list <- as.list(call.) # only pass the args from dots ('...') that are in parnames as.call(c(call.list, dots[pm > 0L])) } isNullOrFalse <- function(x) { is.null(x) || identical(x, FALSE) } # Main plot.xts method. # author: Ross Bennett (adapted from Jeffrey Ryan's chart_Series) plot.xts <- function(x, y=NULL, ..., subset="", panels=NULL, multi.panel=FALSE, col=1:8, up.col=NULL, dn.col=NULL, bg="#FFFFFF", type="l", lty=1, lwd=2, lend=1, main=deparse(substitute(x)), main.timespan=TRUE, observation.based=FALSE, log=FALSE, ylim=NULL, yaxis.same=TRUE, yaxis.left=TRUE, yaxis.right=TRUE, yaxis.ticks=5, major.ticks="auto", minor.ticks=NULL, grid.ticks.on="auto", grid.ticks.lwd=1, grid.ticks.lty=1, grid.col="darkgray", labels.col="#333333", format.labels=TRUE, grid2="#F5F5F5", legend.loc=NULL, extend.xaxis=FALSE){ # Small multiples with multiple pages behavior occurs when multi.panel is # an integer. (i.e. multi.panel=2 means to iterate over the data in a step # size of 2 and plot 2 panels on each page # Make recursive calls and return if(is.numeric(multi.panel)){ multi.panel <- min(NCOL(x), multi.panel) idx <- seq.int(1L, NCOL(x), 1L) chunks <- split(idx, ceiling(seq_along(idx)/multi.panel)) # allow color and line attributes for each panel in a multi.panel plot if(length(lty) < ncol(x)) lty <- rep(lty, length.out = ncol(x)) if(length(lwd) < ncol(x)) lwd <- rep(lwd, length.out = ncol(x)) if(length(col) < ncol(x)) col <- rep(col, length.out = ncol(x)) if(!is.null(panels) && nchar(panels) > 0){ # we will plot the panels, but not plot the data by column multi.panel <- FALSE } else { # we will plot the data by column, but not the panels multi.panel <- TRUE panels <- NULL # set the ylim based on the data passed into the x argument if(yaxis.same) ylim <- range(x[subset], na.rm=TRUE) } for(i in 1:length(chunks)){ tmp <- chunks[[i]] p <- plot.xts(x=x[,tmp], y=y, ...=..., subset=subset, panels=panels, multi.panel=multi.panel, col=col[tmp], up.col=up.col, dn.col=dn.col, bg=bg, type=type, lty=lty[tmp], lwd=lwd[tmp], lend=lend, main=main, observation.based=observation.based, log=log, ylim=ylim, yaxis.same=yaxis.same, yaxis.left=yaxis.left, yaxis.right=yaxis.right, yaxis.ticks=yaxis.ticks, major.ticks=major.ticks, minor.ticks=minor.ticks, grid.ticks.on=grid.ticks.on, grid.ticks.lwd=grid.ticks.lwd, grid.ticks.lty=grid.ticks.lty, grid.col=grid.col, labels.col=labels.col, format.labels=format.labels, grid2=grid2, legend.loc=legend.loc, extend.xaxis=extend.xaxis) if(i < length(chunks)) print(p) } # NOTE: return here so we don't draw another chart return(p) } cs <- new.replot_xts() # major.ticks shouldn't be null so we'll set major.ticks here if it is null if(is.null(major.ticks)) { xs <- x[subset] mt <- c(years=nyears(xs), months=nmonths(xs), days=ndays(xs)) major.ticks <- names(mt)[rev(which(mt < 30))[1]] } # add theme and charting parameters to Env plot.call <- match.call(expand.dots=TRUE) cs$Env$theme <- list(up.col = up.col, dn.col = dn.col, col = col, rylab = yaxis.right, lylab = yaxis.left, bg = bg, grid = grid.col, grid2 = grid2, labels = labels.col, # String rotation in degrees. See comment about 'crt'. Only supported by text() srt = if (hasArg("srt")) eval.parent(plot.call$srt) else 0, # Rotation of axis labels: # 0: parallel to the axis (default), # 1: horizontal, # 2: perpendicular to the axis, # 3: vertical las = if (hasArg("las")) eval.parent(plot.call$las) else 0, # magnification for axis annotation relative to current 'cex' value cex.axis = if (hasArg("cex.axis")) eval.parent(plot.call$cex.axis) else 0.9) # /theme # multiplier to magnify plotting text and symbols cs$Env$cex <- if (hasArg("cex")) eval.parent(plot.call$cex) else 0.6 # lines of margin to the 4 sides of the plot: c(bottom, left, top, right) cs$Env$mar <- if (hasArg("mar")) eval.parent(plot.call$mar) else c(3,2,0,2) # check for colorset or col argument # if col has a length of 1, replicate to NCOL(x) so we can keep it simple # and color each line by its index in col if(hasArg("colorset")) col <- eval.parent(plot.call$colorset) if(length(col) < ncol(x)) col <- rep(col, length.out = ncol(x)) cs$Env$format.labels <- format.labels cs$Env$yaxis.ticks <- yaxis.ticks cs$Env$major.ticks <- if (isTRUE(major.ticks)) "auto" else major.ticks cs$Env$minor.ticks <- if (isTRUE(minor.ticks)) "auto" else minor.ticks cs$Env$grid.ticks.on <- if (isTRUE(grid.ticks.on)) "auto" else grid.ticks.on cs$Env$grid.ticks.lwd <- grid.ticks.lwd cs$Env$grid.ticks.lty <- grid.ticks.lty cs$Env$type <- type # if lty or lwd has a length of 1, replicate to NCOL(x) so we can keep it # simple and draw each line with attributes by index if(length(lty) < ncol(x)) lty <- rep(lty, length.out = ncol(x)) if(length(lwd) < ncol(x)) lwd <- rep(lwd, length.out = ncol(x)) cs$Env$lty <- lty cs$Env$lwd <- lwd cs$Env$lend <- lend cs$Env$legend.loc <- legend.loc cs$Env$extend.xaxis <- extend.xaxis cs$Env$observation.based <- observation.based cs$Env$log <- isTRUE(log) # Do some checks on x if(is.character(x)) stop("'x' must be a time-series object") # Raw returns data passed into function cs$Env$xdata <- x cs$Env$xsubset <- subset cs$Env$column_names <- colnames(x) cs$Env$nobs <- NROW(cs$Env$xdata) cs$Env$main <- main cs$Env$main.timespan <- main.timespan cs$Env$ylab <- if (hasArg("ylab")) eval.parent(plot.call$ylab) else "" xdata_ylim <- cs$create_ylim(cs$Env$xdata[subset,]) if(isTRUE(multi.panel)){ n_cols <- NCOL(cs$Env$xdata) asp <- ifelse(n_cols > 1, n_cols, 3) if (hasArg("yaxis.same") && hasArg("ylim") && !is.null(ylim)) { warning("only 'ylim' or 'yaxis.same' should be provided; using 'ylim'") } for(i in seq_len(n_cols)) { # create a local environment for each panel lenv <- cs$new_environment() lenv$xdata <- cs$Env$xdata[subset,i] lenv$type <- cs$Env$type if (is.null(ylim)) { if (yaxis.same) { lenv$ylim <- xdata_ylim # set panel ylim using all columns lenv$use_fixed_ylim <- FALSE # update panel ylim when rendering } else { panel_ylim <- cs$create_ylim(lenv$xdata) lenv$ylim <- panel_ylim # set panel ylim using this column lenv$use_fixed_ylim <- TRUE # do NOT update panel ylim when rendering } } else { lenv$ylim <- ylim # use the ylim argument value lenv$use_fixed_ylim <- TRUE # do NOT update panel ylim when rendering } # allow color and line attributes for each panel in a multi.panel plot lenv$lty <- cs$Env$lty[i] lenv$lwd <- cs$Env$lwd[i] lenv$col <- cs$Env$theme$col[i] lenv$log <- isTRUE(log) exp <- quote(chart.lines(xdata[xsubset], type=type, lty=lty, lwd=lwd, lend=lend, col=col, log=log, up.col=theme$up.col, dn.col=theme$dn.col, legend.loc=legend.loc)) exp <- as.expression(add.par.from.dots(exp, ...)) # create the panels this_panel <- cs$new_panel(lenv$ylim, asp = asp, envir = lenv, header = cs$Env$column_names[i], draw_left_yaxis = yaxis.left, draw_right_yaxis = yaxis.right, use_fixed_ylim = lenv$use_fixed_ylim, use_log_yaxis = log) # plot data this_panel$add_action(exp, env = lenv) } } else { if(type == "h" && NCOL(x) > 1) warning("only the univariate series will be plotted") if (is.null(ylim)) { yrange <- xdata_ylim # set ylim using all columns use_fixed_ylim <- FALSE # update panel ylim when rendering } else { yrange <- ylim # use the ylim argument value use_fixed_ylim <- TRUE # do NOT update panel ylim when rendering } # create the chart's main panel main_panel <- cs$new_panel(ylim = yrange, asp = 3, envir = cs$Env, header = "", use_fixed_ylim = use_fixed_ylim, draw_left_yaxis = yaxis.left, draw_right_yaxis = yaxis.right, use_log_yaxis = log) exp <- quote(chart.lines(xdata[xsubset], type=type, lty=lty, lwd=lwd, lend=lend, col=theme$col, log=log, up.col=theme$up.col, dn.col=theme$dn.col, legend.loc=legend.loc)) exp <- as.expression(add.par.from.dots(exp, ...)) main_panel$add_action(exp) assign(".xts_chob", cs, .plotxtsEnv) } # Plot the panels or default to a simple line chart if(!is.null(panels) && nchar(panels) > 0) { panels <- parse(text=panels, srcfile=NULL) for( p in 1:length(panels)) { if(length(panels[p][[1]][-1]) > 0) { cs <- eval(panels[p]) } else { cs <- eval(panels[p]) } } } assign(".xts_chob", cs, .plotxtsEnv) cs } # apply a function to the xdata in the xts chob and add a panel with the result addPanel <- function(FUN, main="", on=NA, type="l", col=NULL, lty=1, lwd=1, pch=1, ...){ # get the chob and the raw data (i.e. xdata) chob <- current.xts_chob() # xdata will be passed as first argument to FUN xdata <- chob$Env$xdata fun <- match.fun(FUN) .formals <- formals(fun) if("..." %in% names(.formals)) { # Just call do.call if FUN has '...' x <- try(do.call(fun, c(list(xdata), list(...)), quote=TRUE), silent=TRUE) } else { # Otherwise, ensure we only pass relevant args to FUN .formals <- modify.args(formals=.formals, arglist=list(...)) .formals[[1]] <- quote(xdata) x <- try(do.call(fun, .formals), silent=TRUE) } if(inherits(x, "try-error")) { message(paste("FUN function failed with message", x)) return(NULL) } addSeriesCall <- quote(addSeries(x = x, main = main, on = on, type = type, col = col, lty = lty, lwd = lwd, pch = pch)) addSeriesCall <- add.par.from.dots(addSeriesCall, ...) eval(addSeriesCall) } # Add a time series to an existing xts plot # author: Ross Bennett addSeries <- function(x, main="", on=NA, type="l", col=NULL, lty=1, lwd=1, pch=1, ...){ plot_object <- current.xts_chob() lenv <- plot_object$new_environment() lenv$plot_lines <- function(x, ta, on, type, col, lty, lwd, pch, ...){ xdata <- x$Env$xdata xsubset <- x$Env$xsubset xDataSubset <- xdata[xsubset] # we can add points that are not necessarily at the points # on the main series, but need to ensure the new series only # has index values within the xdata subset if(xsubset == "") { subset.range <- xsubset } else { fmt <- "%Y-%m-%d %H:%M:%OS6" subset.range <- paste(format(start(xDataSubset), fmt), format(end(xDataSubset), fmt), sep = "/") } xds <- .xts(, .index(xDataSubset), tzone=tzone(xdata)) ta.y <- merge(ta, xds)[subset.range] if (!isTRUE(x$Env$extend.xaxis)) { xi <- .index(ta.y) xc <- .index(xds) xsubset <- which(xi >= xc[1] & xi <= xc[length(xc)]) ta.y <- ta.y[xsubset] } chart.lines(ta.y, type=type, col=col, lty=lty, lwd=lwd, pch=pch, ...) } # get tag/value from dots expargs <- substitute(alist(ta=x, on=on, type=type, col=col, lty=lty, lwd=lwd, pch=pch, ...)) # capture values from caller, so we don't need to copy objects to lenv, # since this gives us evaluated versions of all the object values expargs <- lapply(expargs[-1L], eval, parent.frame()) exp <- as.call(c(quote(plot_lines), x = quote(current.xts_chob()), expargs)) xdata <- plot_object$Env$xdata xsubset <- plot_object$Env$xsubset lenv$xdata <- merge(x,xdata,retside=c(TRUE,FALSE)) if(hasArg("ylim")) { ylim <- eval.parent(substitute(alist(...))$ylim) } else { ylim <- range(lenv$xdata[xsubset], na.rm=TRUE) if(all(ylim == 0)) ylim <- c(-1, 1) } lenv$ylim <- ylim if(is.na(on[1])){ # add series to a new panel use_log <- isTRUE(eval.parent(substitute(alist(...))$log)) this_panel <- plot_object$new_panel(lenv$ylim, asp = 1, envir = lenv, header = main, use_log_yaxis = use_log) # plot data this_panel$add_action(exp, env = lenv) } else { for(i in on) { plot_object$add_panel_action(i, exp, lenv) } } plot_object } # Add time series of lines to an existing xts plot # author: Ross Bennett lines.xts <- function(x, ..., main="", on=0, col=NULL, type="l", lty=1, lwd=1, pch=1){ if(!is.na(on[1])) if(on[1] == 0) on[1] <- current.xts_chob()$get_last_action_panel()$id addSeries(x, ...=..., main=main, on=on, type=type, col=col, lty=lty, lwd=lwd, pch=pch) } # Add time series of points to an existing xts plot # author: Ross Bennett points.xts <- function(x, ..., main="", on=0, col=NULL, pch=1){ if(!is.na(on[1])) if(on[1] == 0) on[1] <- current.xts_chob()$get_last_action_panel()$id addSeries(x, ...=..., main=main, on=on, type="p", col=col, pch=pch) } # Add vertical lines to an existing xts plot # author: Ross Bennett addEventLines <- function(events, main="", on=0, lty=1, lwd=1, col=1, ...){ events <- try.xts(events) plot_object <- current.xts_chob() if(!is.na(on[1])) if(on[1] == 0) on[1] <- plot_object$get_last_action_panel()$id if(nrow(events) > 1){ if(length(lty) == 1) lty <- rep(lty, nrow(events)) if(length(lwd) == 1) lwd <- rep(lwd, nrow(events)) if(length(col) == 1) col <- rep(col, nrow(events)) } lenv <- plot_object$new_environment() lenv$plot_event_lines <- function(x, events, on, lty, lwd, col, ...){ xdata <- x$Env$xdata xsubset <- x$Env$xsubset ypos <- x$get_panel(on)$ylim[2] * 0.995 # we can add points that are not necessarily at the points on the main series subset.range <- paste(format(start(xdata[xsubset]), "%Y%m%d %H:%M:%OS6"), format(end(xdata[xsubset]), "%Y%m%d %H:%M:%OS6"), sep = "/") ta.adj <- merge(n=.xts(1:NROW(xdata[xsubset]), .index(xdata[xsubset]), tzone=tzone(xdata)), .xts(rep(1, NROW(events)),# use numeric for the merge .index(events)))[subset.range] # should we not merge and only add events that are in index(xdata)? ta.y <- ta.adj[,-1] # the merge should result in NAs for any object that is not in events event.ind <- which(!is.na(ta.y)) abline(v=x$get_xcoords()[event.ind], col=col, lty=lty, lwd=lwd) text(x=x$get_xcoords()[event.ind], y=ypos, labels=as.character(events[,1]), col=x$Env$theme$labels, ...) } # get tag/value from dots expargs <- substitute(alist(events=events, on=on, lty=lty, lwd=lwd, col=col, ...)) # capture values from caller, so we don't need to copy objects to lenv, # since this gives us evaluated versions of all the object values expargs <- lapply(expargs[-1L], eval, parent.frame()) exp <- as.call(c(quote(plot_event_lines), x = quote(current.xts_chob()), expargs)) if(is.na(on[1])){ xdata <- plot_object$Env$xdata xsubset <- plot_object$Env$xsubset lenv$xdata <- xdata ylim <- range(xdata[xsubset], na.rm=TRUE) lenv$ylim <- ylim # add series to a new panel this_panel <- plot_object$new_panel(lenv$ylim, asp = 1, envir = lenv, header = main) # plot data this_panel$add_action(exp, env = lenv) } else { for(i in on) { plot_object$add_panel_action(i, exp, lenv) } } plot_object } # Add legend to an existing xts plot # author: Ross Bennett addLegend <- function(legend.loc="topright", legend.names=NULL, col=NULL, ncol=1, on=0, ...){ plot_object <- current.xts_chob() if(!is.na(on[1])) if(on[1] == 0) on[1] <- plot_object$get_last_action_panel()$id lenv <- plot_object$new_environment() lenv$plot_legend <- function(x, legend.loc, legend.names, col, ncol, on, bty, text.col, ...){ if(is.na(on[1])){ yrange <- c(0, 1) } else { yrange <- x$get_panel(on)$ylim } # this just gets the data of the main plot # TODO: get the data of panels[on] if(is.null(ncol)){ ncol <- NCOL(x$Env$xdata) } if(is.null(col)){ col <- x$Env$theme$col[1:NCOL(x$Env$xdata)] } if(is.null(legend.names)){ legend.names <- x$Env$column_names } if(missing(bty)){ bty <- "n" } if(missing(text.col)){ text.col <- x$Env$theme$labels } lc <- legend.coords(legend.loc, x$Env$xlim, yrange) legend(x=lc$x, y=lc$y, legend=legend.names, xjust=lc$xjust, yjust=lc$yjust, ncol=ncol, col=col, bty=bty, text.col=text.col, ...) } # get tag/value from dots expargs <- substitute(alist(legend.loc=legend.loc, legend.names=legend.names, col=col, ncol=ncol, on=on, ...)) # capture values from caller, so we don't need to copy objects to lenv, # since this gives us evaluated versions of all the object values expargs <- lapply(expargs[-1L], eval, parent.frame()) exp <- as.call(c(quote(plot_legend), x = quote(current.xts_chob()), expargs)) # if on[1] is NA, then add a new frame for the legend if(is.na(on[1])){ # add legend to a new panel this_panel <- plot_object$new_panel(ylim = c(0, 1), asp = 0.8, envir = lenv, header = "") # legend data this_panel$add_action(exp, env = lenv) } else { for(i in on) { plot_object$add_panel_action(i, exp, lenv) } } plot_object } # Determine legend coordinates based on legend location, # range of x values and range of y values legend.coords <- function(legend.loc, xrange, yrange) { switch(legend.loc, topleft = list(xjust = 0, yjust = 1, x = xrange[1], y = yrange[2]), left = list(xjust = 0, yjust = 0.5, x = xrange[1], y = sum(yrange) / 2), bottomleft = list(xjust = 0, yjust = 0, x = xrange[1], y = yrange[1]), top = list(xjust = 0.5, yjust = 1, x = (xrange[1] + xrange[2]) / 2, y = yrange[2]), center = list(xjust = 0.5, yjust = 0.5, x = (xrange[1] + xrange[2]) / 2, y = sum(yrange) / 2), bottom = list(xjust = 0.5, yjust = 0, x = (xrange[1] + xrange[2]) / 2, y = yrange[1]), topright = list(xjust = 1, yjust = 1, x = xrange[2], y = yrange[2]), right = list(xjust = 1, yjust = 0.5, x = xrange[2], y = sum(yrange) / 2), bottomright = list(xjust = 1, yjust = 0, x = xrange[2], y = yrange[1]) ) } # Add a polygon to an existing xts plot # author: Ross Bennett addPolygon <- function(x, y=NULL, main="", on=NA, col=NULL, ...){ # add polygon to xts plot based on http://dirk.eddelbuettel.com/blog/2011/01/16/ # some simple checks x <- try.xts(x) if(!is.null(y)) stop("y is not null") if(ncol(x) > 2) warning("more than 2 columns detected in x, only the first 2 will be used") plot_object <- current.xts_chob() lenv <- plot_object$new_environment() lenv$plot_lines <- function(x, ta, on, col, ...){ xdata <- x$Env$xdata xsubset <- x$Env$xsubset xDataSubset <- xdata[xsubset] if(is.null(col)) col <- x$Env$theme$col # we can add points that are not necessarily at the points # on the main series, but need to ensure the new series only # has index values within the xdata subset if(xsubset == "") { subset.range <- xsubset } else { fmt <- "%Y-%m-%d %H:%M:%OS6" subset.range <- paste(format(start(xDataSubset), fmt), format(end(xDataSubset), fmt), sep = "/") } xds <- .xts(, .index(xDataSubset), tzone=tzone(xdata)) ta.y <- merge(ta, xds)[subset.range] # NAs in the coordinates break the polygon which is not the behavior we want ta.y <- na.omit(ta.y) # x coordinates n <- seq_len(NROW(ta.y)) xx <- x$get_xcoords(ta.y)[c(1, n, rev(n))] # y coordinates upper and lower # assume first column is upper and second column is lower y coords for # initial prototype yu <- as.vector(coredata(ta.y[,1])) yl <- as.vector(coredata(ta.y[,2])) polygon(x=xx, y=c(yl[1], yu, rev(yl)), border=NA, col=col, ...) } # get tag/value from dots expargs <- substitute(alist(ta=x, col=col, on=on, ...)) # capture values from caller, so we don't need to copy objects to lenv, # since this gives us evaluated versions of all the object values expargs <- lapply(expargs[-1L], eval, parent.frame()) exp <- as.call(c(quote(plot_lines), x = quote(current.xts_chob()), expargs)) xdata <- plot_object$Env$xdata xsubset <- plot_object$Env$xsubset lenv$xdata <- merge(x,xdata,retside=c(TRUE,FALSE)) if(hasArg("ylim")) { ylim <- eval.parent(substitute(alist(...))$ylim) } else { ylim <- range(lenv$xdata[xsubset], na.rm=TRUE) if(all(ylim == 0)) ylim <- c(-1, 1) } lenv$ylim <- ylim if(is.na(on[1])){ # add series to a new panel this_panel <- plot_object$new_panel(ylim = lenv$ylim, asp = 1, envir = lenv, header = main) # plot data this_panel$add_action(exp, env = lenv) } else { for(i in on) { plot_object$add_panel_action(i, exp, lenv) } } plot_object }# polygon # Based on quantmod/R/replot.R new.replot_xts <- function(panel=1,asp=1,xlim=c(1,10),ylim=list(structure(c(1,10),fixed=FALSE))) { # global variables # 'Env' is mainly the environment for the plot window, but some elements are for panels/frames Env <- new.env() Env$active_panel_i <- panel Env$asp <- 1 Env$xlim <- xlim # vector: c(min, max) (same for every panel) Env$last_action_panel_id <- 1 # getters get_ylim <- function() { update_panels(); get_active_panel()[["ylim_render"]] } get_xlim <- function() { update_panels(); Env$xlim } get_active_panel <- function() { get_panel(Env$active_panel_i) } get_last_action_panel <- function() { get_panel(Env$last_action_panel_id) } get_panel <- function(n) { if (n == 0) { get_last_action_panel() } else if (n > 0) { Env$panels[[n]] } else { stop("'n' must be a positive integer") } } add_panel_action <- function(id, expr, env, clip = TRUE, where = c("last", "first", "background"), ...) { if (id < 0) { where <- "first" } else { where <- match.arg(where) } this_panel <- get_panel(abs(id)) this_panel$add_action(expr, env, clip, where, ...) } create_ylim <- function(x, const_y_mult = 0.2) { # Create y-axis limits from 'x'. Jitter the max/min limits by # 'const_y_mult' if the max/min values are the same. lim <- range(x, na.rm = TRUE) if(isTRUE(all.equal(lim[1L], lim[2L]))) { # if max and min are the same if(lim[1L] == 0) { lim <- c(-1, 1) } else { lim <- lim[1L] * c(1 - const_y_mult, 1 + const_y_mult) } } return(lim) } # loop over panels and then actions render_panels <- function() { update_panels() # all panel header/series asp pairs all_asp <- lapply(Env$panels, function(p) p[["asp"]]) all_asp <- do.call(c, all_asp) # panel header asp is always 5% of the total asp panel_header_asp <- 0.05 * sum(all_asp) # update panel header asp values header_loc <- seq(1, length(all_asp), by = 2) all_asp[header_loc] <- panel_header_asp # main header asp is always 4% of the grand total asp main_title_asp <- 0.04 * sum(all_asp) all_asp <- c(main_title_asp, all_asp) n_asp <- length(all_asp) # render main plot header and x-axis plot.window(Env$xlim, c(0, 1)) clip(par("usr")[1], par("usr")[2], 0, 1) eval(Env$main_header_expr, Env) # header eval(Env$main_xaxis_expr, Env) # x-axis # render each panel for (panel_n in seq_along(Env$panels)) { panel <- Env$panels[[panel_n]] # set the current active panel for the entire plot Env$active_panel_i <- panel_n is_header <- TRUE # header is always the first action for (action in panel$actions) { if (is_header) { is_header <- FALSE asp <- panel_header_asp asp_n <- 2 * panel_n ylim <- c(0, 1) } else { asp <- panel$asp["series"] asp_n <- 2 * panel_n + 1 ylim <- panel$ylim_render } # scaled ylim ylim_scale <- all_asp / asp * abs(diff(ylim)) ymin_adj <- sum(ylim_scale[-seq_len(asp_n)]) ymax_adj <- sum(ylim_scale[-(asp_n:n_asp)]) scaled_ylim <- c(ylim[1] - ymin_adj, ylim[2] + ymax_adj) plot.window(Env$xlim, scaled_ylim) if (attr(action, "clip")) { clip(par("usr")[1], par("usr")[2], ylim[1], ylim[2]) } action_env <- attr(action, "env") eval(action, action_env) } } } get_xcoords <- function(xts_object = NULL, at_posix = FALSE) { # unique index for all series (always POSIXct) xcoords <- Env$xycoords$x if (!is.null(xts_object)) { # get the x-coordinates for the observations in xts_object temp_xts <- .xts(seq_along(xcoords), xcoords, tzone = tzone(xts_object)) xcoords <- merge(temp_xts, xts_object, fill = na.locf, # for duplicate index values join = "right", retside = c(TRUE, FALSE)) if (!isTRUE(Env$extend.xaxis)) { xc <- Env$xycoords$x xi <- .index(xcoords) xsubset <- which(xi >= xc[1] & xi <= xc[length(xc)]) xcoords <- xcoords[xsubset] } if(Env$observation.based && !at_posix) { result <- drop(coredata(xcoords)) } else { result <- .index(xcoords) } } else { if(Env$observation.based && !at_posix) { result <- seq_along(xcoords) } else { result <- xcoords } } return(result) } # main plot header Env$main_header_expr <- expression({ local({ text(x = xlim[1], y = 0.98, labels = main, adj = NULL, pos = 4, offset = 0, cex = 1.1, col = theme$labels, font = 2) if (main.timespan) { text(x = xlim[2], y = 0.98, labels = paste(start(xdata[xsubset]), end(xdata[xsubset]), sep = " / "), adj = c(0, 0), pos = 2, offset = 0.5, cex = 1, col = theme$labels, font = NULL) } }, new.env(TRUE, Env)) }) # main plot x-axis Env$main_xaxis_expr <- expression({ local({ # add observation level ticks on x-axis if < 400 obs. if (NROW(xdata[xsubset]) < 400) { axis(1, at = get_xcoords(), labels = FALSE, las = theme$las, lwd.ticks = NULL, mgp = NULL, tcl = 0.3, cex.axis = theme$cex.axis, col = theme$labels, col.axis = theme$grid2) } # and major and/or minor x-axis ticks and labels xcoords <- get_xcoords() x_index <- get_xcoords(at_posix = TRUE) x_data <- .xts(, x_index, tzone = tzone(xdata))[xsubset] use_major <- !isNullOrFalse(major.ticks) use_minor <- !isNullOrFalse(minor.ticks) types <- c("major", "minor")[c(use_major, use_minor)] for (type in types) { if (type== "major") { axt <- axTicksByTime(x_data, ticks.on = major.ticks, format.labels = format.labels) labels <- names(axt) lwd.ticks <- 1.5 } else { axt <- axTicksByTime(x_data, ticks.on = minor.ticks, format.labels = format.labels) labels <- FALSE lwd.ticks <- 0.75 } axis(1, at = xcoords[axt], labels = labels, las = theme$las, lwd.ticks = lwd.ticks, mgp = c(3,1.5,0), tcl = -0.4, cex.axis = theme$cex.axis, col = theme$labels, col.axis = theme$labels) } }, new.env(TRUE, Env)) }) # panel functionality Env$panels <- list() new_panel <- function(ylim, asp, envir, header, ..., use_fixed_ylim = FALSE, draw_left_yaxis = NULL, draw_right_yaxis = NULL, use_log_yaxis = FALSE, title_timespan = FALSE) { panel <- new.env(TRUE, envir) panel$id <- length(Env$panels) + 1 panel$asp <- c(header = 0.25, series = asp) panel$ylim <- ylim panel$ylim_render <- ylim panel$use_fixed_ylim <- isTRUE(use_fixed_ylim) panel$draw_left_yaxis <- ifelse(is.null(draw_left_yaxis), Env$theme$lylab, draw_left_yaxis) panel$draw_right_yaxis <- ifelse(is.null(draw_right_yaxis), Env$theme$rylab, draw_right_yaxis) panel$use_log_yaxis <- isTRUE(use_log_yaxis) panel$header <- header ### actions panel$actions <- list() panel$add_action <- function(expr, env = Env, clip = TRUE, where = c("last", "first", "background"), ...) { if (!is.expression(expr)) { expr <- as.expression(expr) } action <- structure(expr, clip = clip, env = env, ...) panel$actions <- switch(match.arg(where), last = { # after all the existing actions append(panel$actions, list(action)) }, first = { # after the header and grid lines append(panel$actions, list(action), after = 3) }, background = { # after the header (which must be the 1st panel action) append(panel$actions, list(action), after = 1) }) Env$last_action_panel_id <<- panel$id } ### header # NOTE: this must be the 1st action for a panel header_expr <- expression({ text(x = xlim[1], y = 0.3, labels = header, adj = c(0, 0), pos = 4, offset = 0, cex = 0.9, col = theme$labels, font = NULL) }) panel$add_action(header_expr, env = panel) ### y-axis yaxis_expr <- expression({ if (use_fixed_ylim) { # use the ylim argument yl <- ylim } else { # use the updated ylim based on all panel data yl <- ylim_render } # y-axis grid line labels and locations if (use_log_yaxis) { ylim_series <- exp(ylim_render) # labels are based on the raw series values grid_lbl <- pretty(ylim_series, Env$yaxis.ticks) grid_lbl <- grid_lbl[grid_lbl >= ylim_series[1] & grid_lbl <= ylim_series[2]] # locations are based on the log series values grid_loc <- log(grid_lbl) } else { grid_loc <- pretty(yl, Env$yaxis.ticks) grid_loc <- grid_loc[grid_loc >= yl[1] & grid_loc <= yl[2]] grid_lbl <- grid_loc } # draw y-axis grid lines segments(x0 = xlim[1], y0 = grid_loc, x1 = xlim[2], y1 = grid_loc, col = theme$grid, lwd = grid.ticks.lwd, lty = grid.ticks.lty) # draw left y-axis grid labels if (draw_left_yaxis) { text(x = xlim[1], y = grid_loc, labels = format(grid_lbl, justify = "right"), col = theme$labels, srt = theme$srt, offset = 0.5, pos = 2, cex = theme$cex.axis, xpd = TRUE) } # draw right y-axis grid labels if (draw_right_yaxis) { text(x = xlim[2], y = grid_loc, labels = format(grid_lbl, justify = "right"), col = theme$labels, srt = theme$srt, offset = 0.5, pos = 4, cex = theme$cex.axis, xpd = TRUE) } # draw y-axis label title(ylab = ylab[1], mgp = c(1, 1, 0)) }) panel$add_action(yaxis_expr, env = panel) # x-axis grid xaxis_action <- expression(x_grid_lines(xdata, grid.ticks.on, par("usr")[3:4])) panel$add_action(xaxis_action, env = panel) # append the new panel to the panel list Env$panels <- append(Env$panels, list(panel)) return(panel) } update_panels <- function(headers=TRUE) { # Recalculate each panel's 'ylim_render' value based on the # 'xdata' of every action in the panel for (panel_n in seq_along(Env$panels)) { panel <- get_panel(panel_n) if (!panel$use_fixed_ylim) { # set 'ylim_render' to +/-Inf when ylim is NOT fixed, so # it will be updated to include all the panel's data panel$ylim_render <- c(Inf, -Inf) # calculate a new ylim based on all the panel's data for (action in panel$actions) { action_env <- attr(action, "env") action_data <- action_env$xdata if (!is.null(action_data)) { # some actions (e.g. addLegend) do not have 'xdata' dat.range <- create_ylim(action_data[Env$xsubset]) # calculate new ylim based on the combination of the panel's # original ylim and the action's 'xdata' ylim new_ylim <- c(min(panel$ylim[1], dat.range, na.rm = TRUE), max(panel$ylim[2], dat.range, na.rm = TRUE)) # set to new ylim values panel$ylim_render <- new_ylim } } } if (panel$use_log_yaxis) { panel$ylim_render <- log(panel$ylim_render) } } update_xaxis <- function(panel, x_axis) { # Create x-axis values using index values from data from all panels for (action in panel$actions) { action_env <- attr(action, "env") action_data <- action_env$xdata if (!is.null(action_data)) { # some actions (e.g. addLegend) do not have 'xdata' action_xaxis <- .index(action_data[Env$xsubset]) new_xaxis <- sort(unique(c(x_axis, action_xaxis))) if (isTRUE(Env$extend.xaxis)) { result <- new_xaxis } else { xaxis_rng <- range(x_axis, na.rm = TRUE) result <- new_xaxis[new_xaxis >= xaxis_rng[1L] & new_xaxis <= xaxis_rng[2L]] } } } return(result) } x_axis <- .index(Env$xdata[Env$xsubset]) for (panel in Env$panels) { x_axis <- update_xaxis(panel, x_axis) } # Create x/y coordinates using the combined x-axis index Env$xycoords <- xy.coords(x_axis, seq_along(x_axis)) if (Env$observation.based) { Env$xlim <- c(1, length(get_xcoords())) } else { Env$xlim <- range(get_xcoords(), na.rm = TRUE) } } # return replot_env <- new.env() class(replot_env) <- c("replot_xts","environment") replot_env$Env <- Env replot_env$new_panel <- new_panel replot_env$get_xcoords <- get_xcoords replot_env$update_panels <- update_panels replot_env$render_panels <- render_panels replot_env$get_panel <- get_panel replot_env$add_panel_action <- add_panel_action replot_env$get_xlim <- get_xlim replot_env$get_ylim <- get_ylim replot_env$create_ylim <- create_ylim replot_env$get_last_action_panel <- get_last_action_panel replot_env$new_environment <- function() { new.env(TRUE, Env) } # function to plot the x-axis grid lines replot_env$Env$x_grid_lines <- function(x, ticks.on, ylim) { if (isNullOrFalse(ticks.on)) { invisible() } else { if (isTRUE(ticks.on)) ticks.on <- "auto" xcoords <- get_xcoords() x_index <- get_xcoords(at_posix = TRUE) atbt <- axTicksByTime(.xts(, x_index, tzone = tzone(x)), ticks.on = ticks.on) segments(xcoords[atbt], ylim[1L], xcoords[atbt], ylim[2L], col = Env$theme$grid, lwd = Env$grid.ticks.lwd, lty = Env$grid.ticks.lty) } } return(replot_env) } str.replot_xts <- function(object, ...) { print(str(unclass(object))) } print.replot_xts <- function(x, ...) plot(x,...) plot.replot_xts <- function(x, ...) { # must set the background color before calling plot.new obg <- par(bg = x$Env$theme$bg) plot.new() assign(".xts_chob",x,.plotxtsEnv) # only reasonable way to fix X11/quartz issue ocex <- par(cex = if(.Device == "X11") x$Env$cex else x$Env$cex * 1.5) omar <- par(mar = x$Env$mar) oxpd <- par(xpd = FALSE) usr <- par("usr") # reset par on.exit(par(xpd = oxpd$xpd, cex = ocex$cex, mar = omar$mar, bg = obg$bg)) x$render_panels() do.call("clip", as.list(usr)) # reset clipping region invisible(x$Env$actions) } xts/R/Ops.xts.R0000644000176200001440000000614214522244662013004 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `Ops.xts` <- function(e1, e2) { # determine and output class # use 'e1' first because e2 is missing for unary +/-/! if(inherits(e1, "xts")) { # e1 could be a derived class; use its class for output # NOTE: we want the output to be an xts object even if e2 is a derived # class, because Ops.xts() might not create an appropriate derived class # object out_class <- class(e1) } else { # if 'e1' isn't xts, then e2 must be xts or a derived class, otherwise # this method wouldn't have been called out_class <- class(e2) } e <- if (missing(e2)) { .Class <- "matrix" NextMethod(.Generic) } else if (any(nchar(.Method) == 0)) { .Class <- "matrix" NextMethod(.Generic) } else { if( NROW(e1)==NROW(e2) && identical(.index(e1),.index(e2)) ) { .Class <- "matrix" NextMethod(.Generic) } else { tmp.e1 <- merge.xts(e1, e2, all=FALSE, retclass=FALSE, retside=c(TRUE,FALSE), check.names=FALSE) e2 <- merge.xts(e2, e1, all=FALSE, retclass=FALSE, retside=c(TRUE,FALSE), check.names=FALSE) e1 <- tmp.e1 .Class <- "matrix" NextMethod(.Generic) } } # These return an object the same class as input(s); others return a logical object if(.Generic %in% c("+","-","*","/","^","%%","%/%")) { e <- .Call(C_add_class, e, out_class) } if(length(e)==0) { if(is.xts(e1)) { idx <- .index(e1) } else { idx <- .index(e2) } idx[] <- idx[0] attr(e,'index') <- idx } dn <- dimnames(e) if(!is.null(dn[[1L]])) { if(is.null(dn[[2L]])) { attr(e, "dimnames") <- NULL } else { dimnames(e) <- list(NULL, dn[[2L]]) } } if(is.null(attr(e,'index'))) { if(is.xts(e1)) { e <- .xts(e, .index(e1), tclass(e1), tzone(e1), tformat = tformat(e1)) } else if(is.xts(e2)) { e <- .xts(e, .index(e2), tclass(e2), tzone(e2), tformat = tformat(e2)) } else { # neither have class = ('xts', 'zoo'), because they were overwritten # by the result of merge(..., retclass = FALSE). But they still have # an 'index' attribute. ix <- .index(e1) if (is.null(ix)) { ix <- .index(e2) } e <- .xts(e, ix, tclass(ix), tzone(ix), tformat = tformat(ix)) } if(is.null(dim(e1)) && is.null(dim(e2))) dim(e) <- NULL } attr(e, "names") <- NULL e } xts/R/str.R0000644000176200001440000000626014525744640012243 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `str.xts` <- function(object, ..., ncols = 5) { is.data.empty <- is.null(dim(object)) || sum(dim(object)) == 0 is.zero.index <- (length(.index(object)) == 0) nr <- NROW(object) nc <- ifelse(is.data.empty, 0, NCOL(object)) # "zero-length" xts # * index length == 0, but tclass and tzone are set # * NROW == 0 # * NCOL > 0 and may have column names # examples: # str(.xts(1, 1)["1900"]) # str(.xts(cbind(a = 1, b = 2), 1)["1900"]) is.zero.length <- (is.zero.index && nr == 0 && !is.data.empty) # "zero-width" xts # * index length > 0 # * NROW == 0 # * NCOL == 0 # example: # str(.xts(, 1:5)) is.zero.width <- (!is.zero.index && is.data.empty) # "empty" xts # * index length == 0, but tclass and tzone are set # * NROW == 0 # * NCOL == 0 # example: # str(.xts(, numeric(0))) # str(.xts(matrix()[0,0], numeric(0))) is.empty <- (is.zero.index && is.data.empty) if (is.empty) { header <- "An empty xts object" } else if (is.zero.length) { header <- "A zero-length xts object" } else { # zero-width and regular xts objects if (is.zero.width) { header <- "A zero-width xts object on" } else { header <- "An xts object on" } time.range <- sub("/", " / ", .makeISO8601(object), fixed = TRUE) header <- paste(header, time.range, "containing:") } cat(header, "\n") # Data cat(sprintf(" Data: %s [%d, %d]\n", storage.mode(object), nr, nc)) # Column names cnames <- colnames(object) if (!is.null(cnames)) { if (nc > ncols) { more <- nc - ncols cname.str <- sprintf("%s ... with %d more %s", paste(cnames[seq_len(ncols)], collapse = ", "), more, ifelse(more > 1, "columns", "column")) } else { cname.str <- paste(colnames(object), collapse = ", ") } cat(sprintf(" Columns: %s\n", cname.str)) } # Index cat(sprintf(" Index: %s [%d] (TZ: \"%s\")\n", paste(tclass(object), collapse = ","), length(.index(object)), tzone(object))) if (!is.null(CLASS(object))) { cat(sprintf(" Original class: '%s'\n", CLASS(object))) } xts.attr <- xtsAttributes(object) if (!is.null(xts.attr)) { cat(" xts Attributes:\n") str(xts.attr, ..., comp.str = " $ ", no.list = TRUE) } invisible(NULL) } xts/R/xtsible.R0000644000176200001440000000363214522244665013104 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . xtsible <- function(x) { if(inherits(try(as.xts(x),silent=TRUE),'try-error')) { FALSE } else TRUE } use.xts <- try.xts <- function(x, ..., error=TRUE) { if(is.xts(x)) { #attr(x,'.RECLASS') <- FALSE return(x) } xx <- try(as.xts(x,..., .RECLASS=TRUE),silent=TRUE) if(inherits(xx,'try-error')) { if(is.character(error)) { stop(error) } else if(is.function(error)) { return(error(x, ...)) } else if(error) { stop(gsub('\n','',xx)) } else { return(x) } } else { # made positive: now test if needs to be reclassed structure(xx, .RECLASS=TRUE) } } .merge.xts.scalar <- function(x, length.out, ...) { if( length.out == 0) return(vector(storage.mode(x), 0)) if( length(x) == 1 ) return(matrix(rep(x, length.out=length.out))) if( NROW(x) == length.out ) return(x) stop("improper length of one or more arguments to merge.xts") } use.reclass <- Reclass <- function(x) { xx <- match.call() xxObj <- eval.parent(parse(text=all.vars(xx)[1]), 1) inObj <- try.xts(xxObj, error=FALSE) xx <- eval(match.call()[[-1]]) reclass(xx, inObj) } xts/R/isOrdered.R0000644000176200001440000000221714522244662013345 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `isOrdered` <- function(x, increasing=TRUE, strictly=TRUE) { # x must be of type double or integer. Checked in the C code. if(is.character(x)) stop('character ordering unsupported') if(!is.numeric(x)) x = as.numeric(x) .Call(C_do_is_ordered, x = x, increasing = as.logical(increasing), strictly = as.logical(strictly)) } xts/R/tformat.R0000644000176200001440000000311314522244665013100 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `tformat` <- function(x, ...) { UseMethod('tformat') } `tformat<-` <- function(x, value) { UseMethod('tformat<-') } `tformat.default` <- function(x, ...) { attr(x, 'tformat') } `tormat<-.default` <- function(x, value) { attr(x, '.tformat') <- value x } `tformat.xts` <- function(x, ...) { ix <- .index(x) attr(ix, 'tformat') } `tformat<-.xts` <- function(x, value) { if(!is.character(value) && !is.null(value)) stop('must provide valid POSIX formatting string') # Remove format attrs (object created before 0.10-3) attr(x, ".indexFORMAT") <- NULL attr(attr(x, 'index'), 'tformat') <- value x } `indexFormat` <- function(x) { .Deprecated("tformat", "xts") tformat(x) } `indexFormat<-` <- function(x, value) { .Deprecated("tformat<-", "xts") `tformat<-`(x, value) } xts/R/lag.xts.R0000644000176200001440000000777014522244662013016 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `Lag.xts` <- function(x, k=1, na.action=na.pass, ...) { x <- try.xts(x, error=FALSE) if(!is.xts(x)) x <- as.matrix(x) xx <-sapply(k, function(k) { apply(x, 2, function(x) { if(k==0) return(as.matrix(x)) as.matrix(c(rep(NA, k), x[-((length(x) - k + 1):length(x))])) } )} ) xx <- matrix(as.numeric(xx),nrow=NROW(x)) colnames(xx) <- c(paste(colnames(x)[(rep(1:NCOL(x),length(k)))], 'lag', rep(k, each=NCOL(x)), sep = ".")) as.function(na.action)(reclass(xx,x)) } `Next.xts` <- function(x, k=1, na.action=na.pass, ...) { x <- try.xts(x, error=FALSE) if(!is.xts(x)) x <- as.matrix(x) xx <-sapply(k, function(k) { apply(x, 2, function(x) { if(k==0) return(as.matrix(x)) as.matrix(c(x[-(1:k)],rep(NA, k))) } )} ) xx <- matrix(as.numeric(xx),nrow=NROW(x)) colnames(xx) <- c(paste(colnames(x)[(rep(1:NCOL(x),length(k)))], 'next', rep(k, each=NCOL(x)), sep = ".")) as.function(na.action)(reclass(xx,x)) } lag.xts <- function(x, k=1, na.pad=TRUE, ...) { zooCompat <- getOption('xts.compat.zoo.lag') if(is.logical(zooCompat) && zooCompat) { k <- -k if(missing(na.pad)) na.pad <- FALSE } if(length(k) > 1) { if(is.null(names(k))) names(k) <- paste("lag",k,sep="") return(do.call("merge.xts", lapply(k, lag.xts, x=x, na.pad=na.pad,...))) } .Call(C_lag_xts, x, k, na.pad) } lagts.xts <- function(x, k=1, na.pad=TRUE, ...) { if(length(k) > 1) { if(is.null(names(k))) names(k) <- paste("lag",k,sep="") return(do.call("merge.xts", lapply(k, lag.xts, x=x, na.pad=na.pad,...))) } .Call(C_lag_xts, x, k, na.pad) } diff.xts <- function(x, lag=1, differences=1, arithmetic=TRUE, log=FALSE, na.pad=TRUE, ...) { if(!is.integer(lag) && any(is.na(as.integer(lag)))) stop("'lag' must be integer") differences <- as.integer(differences[1L]) if(is.na(differences)) stop("'differences' must be integer") if(is.logical(x)) { x <- .xts(matrix(as.integer(x), ncol=NCOL(x)), .index(x), tclass(x), dimnames=dimnames(x)) } if(lag < 1 || differences < 1) stop("'diff.xts' defined only for positive lag and differences arguments") zooCompat <- getOption('xts.compat.zoo.lag') if(is.logical(zooCompat) && zooCompat) { # this has to negated to satisfy the test in lag.xts... oh my lag <- -lag if(missing(na.pad)) na.pad <- FALSE } if(differences > 1) { if(arithmetic && !log) { #log is FALSE or missing x <- x - lag.xts(x, k=lag, na.pad=na.pad) } else { if(log) { x <- log(x/lag.xts(x, k=lag, na.pad=na.pad)) } else x <- x/lag.xts(x, k=lag, na.pad=na.pad) } diff(x, lag, differences=differences-1, arithmetic=arithmetic, log=log, na.pad=na.pad, ...) } else { if(arithmetic && !log) { x - lag.xts(x, k=lag, na.pad=na.pad) } else { if(log) { log(x/lag.xts(x, k=lag, na.pad=na.pad)) } else x/lag.xts(x, k=lag, na.pad=na.pad) } } } xts/R/dimnames.R0000644000176200001440000000220314522244662013215 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # dimnames will return the actual dimnames of the xts object # dimnames<-.xts will force the rownames to always be NULL `dimnames.xts` <- function(x) { #list(NULL, colnames(unclass(x))) .Call(C_dimnames_zoo,x); #list(as.character(index(x)), colnames(unclass(x))) } `dimnames<-.xts` <- function(x, value) { .Call(C_xts_set_dimnames, x, value) } xts/R/endpoints.R0000644000176200001440000001054214522244662013430 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . endpoints <- function(x,on='months',k=1) { if(k < 1) { stop("'k' must be > 0") } if(timeBased(x)) { NR <- length(x) x <- xts(, order.by=x) } else NR <- NROW(x) addlast <- TRUE # remove automatic NR last value if(!is.xts(x)) x <- try.xts(x, error='must be either xts-coercible or timeBased') # special-case "secs" and "mins" for back-compatibility if(on == "secs" || on == "mins") on <- substr(on, 1L, 3L) on <- match.arg(on, c("years", "quarters", "months", "weeks", "days", "hours", "minutes", "seconds", "milliseconds", "microseconds", "ms", "us")) # posixltindex is costly in memory (9x length of time) # make sure we really need it if(on %in% c('years','quarters','months','weeks','days')) posixltindex <- as.POSIXlt(.POSIXct(.index(x)),tz=tzone(x)) include_last <- function(x, k) { len <- length(x) i <- seq(1L ,len, k) if(i[length(i)] != len) { i <- c(i, len) } ep[i] } switch(on, "years" = { as.integer(c(0, which(diff(posixltindex$year %/% k + 1) != 0), NR)) }, "quarters" = { ixyear <- posixltindex$year * 100L + 190000L ixqtr <- ixyear + posixltindex$mon %/% 3L + 1L ep <- c(0L, which(diff(ixqtr) != 0L), NR) if(k > 1) { ep <- include_last(ep, k) } ep }, "months" = { ixmon <- posixltindex$year * 100L + 190000L + posixltindex$mon ep <- .Call(C_endpoints, ixmon, 1L, 1L, addlast) if(k > 1) { ep <- include_last(ep, k) } ep }, "weeks" = { .Call(C_endpoints, .index(x)+3L*86400L, 604800L, k, addlast) }, "days" = { ixyday <- posixltindex$year * 1000L + 1900000L + posixltindex$yday .Call(C_endpoints, ixyday, 1L, k, addlast) }, # non-date slicing should be indifferent to TZ and DST, so use math instead "hours" = { .Call(C_endpoints, .index(x), 3600L, k, addlast) }, "minutes" = { .Call(C_endpoints, .index(x), 60L, k, addlast) }, "seconds" = { .Call(C_endpoints, .index(x), 1L, k, addlast) }, "ms" = , "milliseconds" = { sec2ms <- .index(x) * 1e3 .Call(C_endpoints, sec2ms, 1L, k, addlast) }, "us" = , "microseconds" = { sec2us <- .index(x) * 1e6 .Call(C_endpoints, sec2us, 1L, k, addlast) } ) } `startof` <- function(x,by='months', k=1) { ep <- endpoints(x,on=by, k=k) (ep+1)[-length(ep)] } `endof` <- function(x,by='months', k=1) { endpoints(x,on=by, k=k)[-1] } `firstof` <- function(year=1970,month=1,day=1,hour=0,min=0,sec=0,tz="") { ISOdatetime(year,month,day,hour,min,sec,tz) } lastof <- function (year = 1970, month = 12, day = 31, hour = 23, min = 59, sec = 59, subsec=.99999, tz = "") { if(!missing(sec) && sec %% 1 != 0) subsec <- 0 sec <- ifelse(year < 1970, sec, sec+subsec) # <1970 asPOSIXct bug workaround #sec <- sec + subsec mon.lengths <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) if (missing(day)) { day <- ifelse(month %in% 2, ifelse(((year%%4 %in% 0 & !year%%100 %in% 0) | (year%%400 %in% 0)), 29, 28), mon.lengths[month]) } # strptime has an issue (bug?) which returns NA when passed # 1969-12-31-23-59-59; pass 58.9 secs instead. sysTZ <- Sys.getenv("TZ") if (length(c(year, month, day, hour, min, sec)) == 6 && all(c(year, month, day, hour, min, sec) == c(1969, 12, 31, 23, 59, 59)) && (sysTZ == "" || isUTC(sysTZ))) sec <- sec-1 ISOdatetime(year, month, day, hour, min, sec, tz) } xts/R/na.R0000644000176200001440000000666414522244665012040 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . na.omit.xts <- function(object, ...) { xx <- .Call(C_na_omit_xts, object) if(length(xx)==0) return(structure(xts(,),.Dim=c(0,NCOL(object)))) naa <- attr(xx,'na.action') if(length(naa) == 0) return(xx) naa.index <- .index(object)[naa] ROWNAMES <- attr(object,'.ROWNAMES') if(!is.null(ROWNAMES)) { naa.rownames <- ROWNAMES[naa] } else naa.rownames <- NULL attr(xx,'na.action') <- structure(naa, index=naa.index, .ROWNAMES=naa.rownames) return(xx) } na.exclude.xts <- function(object, ...) { xx <- .Call(C_na_omit_xts, object) naa <- attr(xx,'na.action') if(length(naa) == 0) return(xx) naa.index <- .index(object)[naa] ROWNAMES <- attr(object,'.ROWNAMES') if(!is.null(ROWNAMES)) { naa.rownames <- ROWNAMES[naa] } else naa.rownames <- NULL attr(xx,'na.action') <- structure(naa, class="exclude", index=naa.index, .ROWNAMES=naa.rownames) return(xx) } na.restore <- function(object, ...) { UseMethod("na.restore") } na.restore.xts <- function(object, ...) { if(is.null(na.action(object))) return(object) structure(merge(structure(object,na.action=NULL), .xts(,attr(na.action(object),"index"))), .Dimnames=list(NULL, colnames(object))) } na.replace <- function(x) { .Deprecated("na.restore") if(is.null(xtsAttributes(x)$na.action)) return(x) # Create 'NA' xts object tmp <- xts(matrix(rep(NA,NCOL(x)*NROW(x)), ncol=NCOL(x)), attr(xtsAttributes(x)$na.action, 'index')) # Ensure xts 'NA' object has *all* the same attributes # as the object 'x'; this is necessary for rbind to # work correctly CLASS(tmp) <- CLASS(x) xtsAttributes(tmp) <- xtsAttributes(x) attr(x,'na.action') <- attr(tmp,'na.action') <- NULL colnames(tmp) <- colnames(x) rbind(x,tmp) } na.locf.xts <- function(object, na.rm=FALSE, fromLast=FALSE, maxgap=Inf, ...) { maxgap <- min(maxgap, NROW(object)) if(length(object) == 0) return(object) if(hasArg("x") || hasArg("xout")) return(NextMethod(.Generic)) x <- .Call(C_na_locf, object, fromLast, maxgap, Inf) if(na.rm) { return(structure(na.omit(x),na.action=NULL)) } else x } na.fill.xts <- function(object, fill, ix, ...) { if (length(fill) == 1 && missing(ix)) { # na.fill0() may change the storage type of 'object' # make sure 'fill' argument is same type as 'object' fill. <- fill storage.mode(fill.) <- storage.mode(object) return(na.fill0(object, fill.)) } else { NextMethod(.Generic) } } xts/R/period.apply.R0000644000176200001440000001054214525744640014037 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . .mean_by_column_message <- function(caller) { if (getOption("xts.message.period.apply.mean", TRUE)) { message("NOTE: `", caller, "(..., FUN = mean)` operates by column, unlike other math\n ", "functions (e.g. median, sum, var, sd). Please use `FUN = colMeans` instead,\n ", "and use `FUN = function(x) mean(x)` to take the mean of all columns. Set\n ", "`options(xts.message.period.apply.mean = FALSE)` to suppress this message.") } # changing this behavior will break code in the following dependencies: # # ATAforecasting/R/ATA_Find_Multi_Freq.R # bidask/R/utils.R # dsa/R/HelperFunctions.R # {.tomonth} # RavenR/inst/doc/Introduction_to_RavenR.R # RavenR/inst/doc/Introduction_to_RavenR.Rmd # RavenR/R/rvn_apply_wyearly.R # RavenR/R/rvn_monthly_vbias.R # rts/man/apply.monthly.Rd # rts/man/period.apply.Rd # RWDataPlyr/R/xts_helperFunctions.R } `period.apply` <- function(x, INDEX, FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("period.apply") } x <- try.xts(x, error = FALSE) FUN <- match.fun(FUN) if(!isOrdered(INDEX)) { # isOrdered returns FALSE if there are duplicates INDEX <- sort(unique(INDEX)) } if(INDEX[1] != 0) { INDEX <- c(0, INDEX) } if(last(INDEX) != NROW(x)) { INDEX <- c(INDEX, NROW(x)) } xx <- sapply(1:(length(INDEX) - 1), function(y) { FUN(x[(INDEX[y] + 1):INDEX[y + 1]], ...) }) if(is.vector(xx)) xx <- t(xx) xx <- t(xx) if(is.null(colnames(xx)) && NCOL(x)==NCOL(xx)) colnames(xx) <- colnames(x) reclass(xx, x[INDEX]) } `period.apply.original` <- function (x, INDEX, FUN, ...) { x <- use.xts(x,error=FALSE) if(!is.xts(x)) { FUN <- match.fun(FUN) xx <- sapply(1:(length(INDEX) - 1), function(y) { FUN(x[(INDEX[y] + 1):INDEX[y + 1]], ...) }) } else { FUN <- match.fun(FUN) new.index <- index(x)[INDEX] xx <- sapply(1:(length(INDEX) - 1), function(y) { FUN(x[(INDEX[y] + 1):INDEX[y + 1]], ...) }) xx <- xts(xx,new.index) CLASS(xx) <- CLASS(x) xtsAttributes(xx) <- xtsAttributes(x) xx <- reclass(xx) } xx } `apply.daily` <- function(x,FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("apply.daily") } ep <- endpoints(x,'days') period.apply(x,ep,FUN, ...) } `apply.weekly` <- function(x,FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("apply.weekly") } ep <- endpoints(x,'weeks') period.apply(x,ep,FUN, ...) } `apply.monthly` <- function(x,FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("apply.monthly") } ep <- endpoints(x,'months') period.apply(x,ep,FUN, ...) } `apply.quarterly` <- function(x,FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("apply.quarterly") } ep <- endpoints(x,'quarters') period.apply(x,ep,FUN, ...) } `apply.yearly` <- function(x,FUN, ...) { if (deparse(substitute(FUN))[1] == "mean") { .mean_by_column_message("apply.yearly") } ep <- endpoints(x,'years') period.apply(x,ep,FUN, ...) } period_apply <- function(x, INDEX, FUN, ...) { fun <- substitute(FUN) e <- new.env() if (INDEX[1] != 0) { INDEX <- c(0, INDEX) } if (INDEX[length(INDEX)] != NROW(x)) { INDEX <- c(INDEX, NROW(x)) } pl <- .Call(C_xts_period_apply, x, INDEX, fun, e) .xts(do.call(rbind, pl), .index(x)[INDEX], tclass = tclass(x), tzone = tzone(x)) } xts/R/startOfYear.R0000644000176200001440000000201714522244665013671 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `startOfYear` <- function(from=1900, to=2200, origin=1970) { .Call(C_do_startofyear, from = as.integer(from), to = as.integer(to), origin = as.integer(origin)) } xts/R/write.xts.R0000644000176200001440000000232014522244665013372 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `write.xts` <- function(x) { NC <- NCOL(x) NR <- NROW(x) DAT <- c(NC,NR) x <- c(.index(x), as.numeric(x)) offset <- 0 for(i in 1:(NC+1)) { end <- seq(i+offset*NR, length.out=NR)-offset DAT <- c(DAT, c(x[end[1]], diff(x[end]))) offset <- offset + 1 } DAT } `read.xts` <- function(x) { NC <- x[1] NR <- x[2] x <- x[-c(1:2)] .xts(apply(matrix(x[-(1:NR)], ncol=NC),2,cumsum), cumsum(x[1:NR])) } xts/R/zoo.R0000644000176200001440000000357614522244665012250 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # functions to handle zoo <--> xts conversions `re.zoo` <- function(x,...) { xx <- coredata(x) xx <- zoo(xx, order.by=index(x), ...) if(length(dimnames(x)[[2]]) < 2) { dimnames(xx) <- NULL dim(xx) <- NULL attr(xx,'names') <- as.character(index(x)) } xx } `as.xts.zoo` <- function(x,order.by=index(x),frequency=NULL,...,.RECLASS=FALSE) { if(.RECLASS) { xx <- xts(coredata(x), # Cannot use 'zoo()' on objects of class 'zoo' - jmu order.by=order.by, frequency=frequency, .CLASS='zoo', ...) } else { xx <- xts(coredata(x), # Cannot use 'zoo()' on objects of class 'zoo' - jmu order.by=order.by, frequency=frequency, ...) } # # if(!is.null(attr(x,'names'))) { # dim(xx) <- c(NROW(xx),NCOL(xx)) # dn <- list(attr(x,'names'),colnames(x)) # dimnames(xx) <- dn # attr(xx,'.ROWNAMES') <- attr(x,'names') # } # xx } `as.zoo.xts` <- function(x,...) { cd <- coredata(x); if( length(cd)==0 ) cd <- NULL zoo(cd, order.by=index(x), ...) } xts/R/irts.R0000644000176200001440000000300014522244662012375 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # methods for tseries::irts `re.irts` <- function(x,...) { if(!requireNamespace('tseries', quietly=TRUE)) { irts <- function(...) message("package 'tseries' is required for re.irts") } else { irts <- tseries::irts } tclass(x) <- "POSIXct" xx <- coredata(x) # rownames(xx) <- attr(x,'irts.rownames') irts(index(x),xx) } `as.xts.irts` <- function(x,order.by,frequency=NULL,...,.RECLASS=FALSE) { if(.RECLASS) { xx <- xts(x=x$value, order.by=x$time, frequency=frequency, .CLASS='irts', # irts.rownames=rownames(x$value), ...) } else { xx <- xts(x=x$value, order.by=x$time, frequency=frequency, ...) } xx } xts/R/timeDate.R0000644000176200001440000000154314522244665013165 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . as.xts.timeDate <- function(x, ...) { xts(x=NULL, order.by=x) } xts/R/timeBasedSeq.R0000644000176200001440000000753614522244665014007 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `timeBasedSeq` <- function(x, retclass=NULL, length.out=NULL) { if(!is.character(x)) # allows for unquoted numerical expressions to work x <- deparse(match.call()$x) x <- gsub('::','/',x, perl=TRUE) # replace all '::' range ops with '/' x <- gsub('[-:]','',x, perl=TRUE) # strip all remaining '-' and ':' seps x <- gsub('[ ]','',x, perl=TRUE) # strip all remaining white space x <- unlist(strsplit(x,"/")) from <- x[1] to <- x[2] BY <- x[3] # need to test for user specified length.out, currently just overriding if(from == "") from <- NA if(!is.na(from)) { year <- as.numeric(substr(from,1,4)) month <- as.numeric(substr(from,5,6)) day <- as.numeric(substr(from,7,8)) hour <- as.numeric(substr(from,9,10)) mins <- as.numeric(substr(from,11,12)) secs <- as.numeric(substr(from,13,14)) time.args.from <- as.list(unlist(sapply(c(year,month,day,hour,mins,secs), function(x) if(!is.na(x)) x) )) from <- do.call('firstof',time.args.from) } else time.args.from <- list() # only calculate if to is specified if(!is.na(to)) { year <- as.numeric(substr(to,1,4)) month <- as.numeric(substr(to,5,6)) day <- as.numeric(substr(to,7,8)) hour <- as.numeric(substr(to,9,10)) mins <- as.numeric(substr(to,11,12)) secs <- as.numeric(substr(to,13,14)) time.args.to <- as.list(unlist(sapply(c(year,month,day,hour,mins,secs), function(x) if(!is.na(x)) x) )) to <- do.call('lastof',time.args.to) } else time.args.to <- list() max.resolution <- max(length(time.args.from), length(time.args.to)) # if neither is set if(max.resolution == 0) max.resolution <- 1 resolution <- c('year','month','DSTday','hour','mins','secs')[max.resolution] if(!is.na(BY)) resolution <- names(match.arg(BY, list(year ='Y', month ='m', day ='d', hour ='H', mins ='M', secs ='S'))) convert.to <- 'Date' if(max.resolution == 2 || resolution == 'month' ) convert.to <- 'yearmon' if(max.resolution > 3 || resolution %in% c("hour","mins","secs")) convert.to <- 'POSIXct' if(is.na(to) && missing(length.out)) length.out <- 1L if(((!missing(retclass) && is.null(retclass)) || any(is.na(to),is.na(from)))) { # return the calculated values only return(list(from=from,to=to,by=resolution,length.out=length.out)) } if(is.null(length.out)) { SEQ <- seq(from,to,by=resolution) } else { SEQ <- seq(from, by=resolution, length.out=length.out) } if(!is.null(retclass)) convert.to <- retclass if(convert.to == 'POSIXct') { structure(SEQ, class=c('POSIXct','POSIXt')) # need to force the TZ to be used } else do.call(paste('as',convert.to,sep='.'), list(SEQ)) } xts/R/OHLC.R0000644000176200001440000000725014522244662012154 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # functions from quantmod to check for OHLC style/columns # NOT TO BE EXPORTED # `OHLCV` <- function (x) { if (is.OHLCV(x)) return(x[, has.OHLCV(x, 1)]) NULL } `is.OHLCV` <- function(x) { all(has.Op(x),has.Hi(x),has.Lo(x),has.Cl(x),has.Vo(x)) } `has.OHLCV` <- function(x,which=FALSE) { if(which) { c(has.Op(x,1),has.Hi(x,1),has.Lo(x,1),has.Cl(x,1),has.Vo(x,1)) } else { c(has.Op(x),has.Hi(x),has.Lo(x),has.Cl(x),has.Vo(x)) } } `OHLC` <- function (x) { if (is.OHLC(x)) return(x[, has.OHLC(x, 1)]) NULL } `is.OHLC` <- function(x) { all(has.Op(x),has.Hi(x),has.Lo(x),has.Cl(x)) } `has.OHLC` <- function(x,which=FALSE) { if(which) { c(has.Op(x,1),has.Hi(x,1),has.Lo(x,1),has.Cl(x,1)) } else { c(has.Op(x),has.Hi(x),has.Lo(x),has.Cl(x)) } } `HLC` <- function (x) { if (is.HLC(x)) return(x[, has.HLC(x, 1)]) NULL } `is.HLC` <- function(x) { all(has.Hi(x),has.Lo(x),has.Cl(x)) } `has.HLC` <- function(x,which=FALSE) { if(which) { c(has.Hi(x,1),has.Lo(x,1),has.Cl(x,1)) } else { c(has.Hi(x),has.Lo(x),has.Cl(x)) } } `Op` <- function(x) { if(has.Op(x)) return(x[,grep('Open',colnames(x),ignore.case=TRUE)]) NULL } `has.Op` <- function(x,which=FALSE) { loc <- grep('Open',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } `Hi` <- function(x) { if(has.Hi(x)) return(x[,grep('High',colnames(x),ignore.case=TRUE)]) NULL } `has.Hi` <- function(x,which=FALSE) { loc <- grep('High',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } `Lo` <- function(x) { if(has.Lo(x)) return(x[,grep('Low',colnames(x),ignore.case=TRUE)]) NULL } `has.Lo` <- function(x,which=FALSE) { loc <- grep('Low',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } `Cl` <- function(x) { if(has.Cl(x)) return(x[,grep('Close',colnames(x),ignore.case=TRUE)]) NULL } `has.Cl` <- function(x,which=FALSE) { loc <- grep('Close',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } `Vo` <- function(x) { #vo <- grep('Volume',colnames(x)) #if(!identical(vo,integer(0))) if(has.Vo(x)) return(x[,grep('Volume',colnames(x),ignore.case=TRUE)]) NULL } `has.Vo` <- function(x,which=FALSE) { loc <- grep('Volume',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } `Ad` <- function(x) { if(has.Ad(x)) return(x[,grep('Adjusted',colnames(x),ignore.case=TRUE)]) NULL } `has.Ad` <- function(x,which=FALSE) { loc <- grep('Adjusted',colnames(x),ignore.case=TRUE) if(!identical(loc,integer(0))) return(ifelse(which,loc,TRUE)) ifelse(which,loc,FALSE) } xts/R/merge.R0000644000176200001440000001061414522244664012526 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . merge.xts <- function(..., all=TRUE, fill=NA, suffixes=NULL, join="outer", retside=TRUE, retclass="xts", tzone=NULL, drop=NULL, check.names=NULL) { if(is.null(check.names)) { check.names <- TRUE } if(is.logical(retclass) && !retclass) { setclass=FALSE } else setclass <- TRUE fill.fun <- NULL if(is.function(fill)) { fill.fun <- fill fill <- NA } # as.list(substitute(list(...))) # this is how zoo handles colnames - jar mc <- match.call(expand.dots=FALSE) dots <- mc$... if(is.null(suffixes)) { syms <- names(dots) if(is.null(syms)) { # Based on makeNames() in merge.zoo() syms <- substitute(alist(...))[-1L] nm <- names(syms) fixup <- if (is.null(nm)) seq_along(syms) else !nzchar(nm) dep <- sapply(syms[fixup], function(x) deparse(x, nlines = 1L)) if(is.null(nm)) { nm <- dep } else if(any(fixup)) { nm[fixup] <- dep } syms <- nm } else { have.symnames <- nzchar(syms) if(any(!have.symnames)) { syms[!have.symnames] <- as.character(dots[!have.symnames]) } } } else if(length(suffixes) != length(dots)) { warning("length of suffixes and does not match number of merged objects") syms <- as.character(dots) # should we ignore suffixes here? #suffixes <- NULL } else { syms <- as.character(suffixes) } .times <- .External(C_number_of_cols, ...) # moved call to make.names inside of mergeXts/do_merge_xts symnames <- rep(syms, .times) suffixes <- rep(suffixes, .times) if(length(dots) == 1) { # this is for compat with zoo; one object AND a name if(!is.null(names(dots))) { x <- list(...)[[1]] if(is.null(colnames(x))) colnames(x) <- symnames return(x) } } if( !missing(join) ) { # join logic applied to index: # inspired by: http://blogs.msdn.com/craigfr/archive/2006/08/03/687584.aspx # # (full) outer - all cases, equivelant to all=c(TRUE,TRUE) # left - all x, && y's that match x # right - all ,y && x's that match y # inner - only x and y where index(x)==index(y) all <- switch(pmatch(join,c("outer","left","right","inner")), c(TRUE, TRUE ), # outer c(TRUE, FALSE), # left c(FALSE, TRUE ), # right c(FALSE, FALSE) # inner ) if( length(dots) > 2 ) { all <- all[1] warning("'join' only applicable to two object merges") } } if( length(all) != 2 ) { if( length(all) > 2 ) warning("'all' must be of length two") all <- rep(all[1], 2) } if( length(dots) > 2 ) retside <- TRUE if( length(retside) != 2 ) retside <- rep(retside[1], 2) x <- .External(C_mergeXts, all=all[1:2], fill=fill, setclass=setclass, symnames=symnames, suffixes=suffixes, retside=retside, env=new.env(), tzone=tzone, check.names=check.names, ...) if(!is.logical(retclass) && retclass != 'xts') { asFun <- paste("as", retclass, sep=".") if(!exists(asFun)) { warning(paste("could not locate",asFun,"returning 'xts' object instead")) return(x) } xx <- try(do.call(asFun, list(x))) if(!inherits(xx,'try-error')) { return(xx) } } if(!is.null(fill.fun)) { fill.fun(x) } else return(x) } xts/R/last.R0000644000176200001440000001162614522244662012374 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . `last` <- function(x,...) { UseMethod("last") } `last.default` <- function(x,n=1,keep=FALSE,...) { if(length(x) == 0) return(x) if(is.character(n)) { xx <- try.xts(x, error=FALSE) if(is.xts(xx)) { xx <- last.xts(x, n=n, keep=keep, ...) return(reclass(xx)) } } if(is.null(dim(x))) { if(n > 0) { sub <- seq.int(to = length(x), length.out = min(n, length(x))) xx <- x[sub] if(keep) xx <- structure(xx,keep=x[1:(NROW(x)+(-n))]) xx } else if(n < 0) { sub <- seq_len(max(length(x) + n, 0L)) xx <- x[sub] if(keep) xx <- structure(xx,keep=x[((NROW(x)-(-n)+1):NROW(x))]) xx } else { xx <- x[0] if(keep) xx <- structure(xx,keep=x[0]) xx } } else { if(n > 0) { sub <- seq.int(to = NROW(x), length.out = min(n, NROW(x))) xx <- x[sub,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[1:(NROW(x)+(-n)),]) xx } else if(n < 0) { sub <- seq_len(max(NROW(x) + n, 0L)) xx <- x[sub,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[((NROW(x)-(-n)+1):NROW(x)),]) xx } else { xx <- x[0,,drop=FALSE] if(keep) xx <- structure(xx,keep=x[0,]) xx } } } `last.xts` <- function(x,n=1,keep=FALSE,...) { if(length(x) == 0) return(x) if(is.character(n)) { # n period set np <- strsplit(n," ",fixed=TRUE)[[1]] if(length(np) > 2 || length(np) < 1) stop(paste("incorrectly specified",sQuote("n"),sep=" ")) # series periodicity sp <- periodicity(x) sp.units <- sp[["units"]] # requested periodicity$units rpu <- np[length(np)] rpf <- ifelse(length(np) > 1, as.numeric(np[1]), 1) if(rpu == sp.units) { n <- rpf } else { # if singular - add an s to make it work if(substr(rpu,length(strsplit(rpu,'')[[1]]),length(strsplit(rpu,'')[[1]])) != 's') rpu <- paste(rpu,'s',sep='') u.list <- list(secs=4,seconds=4,mins=3,minutes=3,hours=2,days=1, weeks=1,months=1,quarters=1,years=1) dt.options <- c('seconds','secs','minutes','mins','hours','days', 'weeks','months','quarters','years') if(!rpu %in% dt.options) stop(paste("n must be numeric or use",paste(dt.options,collapse=','))) dt <- dt.options[pmatch(rpu,dt.options)] if(u.list[[dt]] > u.list[[sp.units]]) { # req is for higher freq data period e.g. 100 mins of daily data stop(paste("At present, without some sort of magic, it isn't possible", "to resolve",rpu,"from",sp$scale,"data")) } ep <- endpoints(x,dt) if(rpf > length(ep)-1) { rpf <- length(ep)-1 warning("requested length is greater than original") } if(rpf > 0) { n <- ep[length(ep)-rpf]+1 if(is.null(dim(x))) { xx <- x[n:NROW(x)] } else { xx <- x[n:NROW(x),,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[1:(ep[length(ep)+(-rpf)])]) return(xx) } else if(rpf < 0) { n <- ep[length(ep)+rpf] if(is.null(dim(x))) { xx <- x[1:n] } else { xx <- x[1:n,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[(ep[length(ep)-(-rpf)]+1):NROW(x)]) return(xx) } else { if(is.null(dim(x))) { xx <- x[0] } else { xx <- x[0,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[0]) return(xx) } } } if(length(n) != 1) stop("n must be of length 1") if(n > 0) { n <- min(n, NROW(x)) if(is.null(dim(x))) { xx <- x[(NROW(x)-n+1):NROW(x)] } else { xx <- x[(NROW(x)-n+1):NROW(x),,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[1:(NROW(x)+(-n))]) xx } else if(n < 0) { if(abs(n) >= NROW(x)) return(x[0]) if(is.null(dim(x))) { xx <- x[1:(NROW(x)+n)] } else { xx <- x[1:(NROW(x)+n),,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[((NROW(x)-(-n)+1):NROW(x))]) xx } else { if(is.null(dim(x))) { xx <- x[0] } else { xx <- x[0,,drop=FALSE] } if(keep) xx <- structure(xx,keep=x[0]) xx } } xts/R/origin.fix.R0000644000176200001440000000446114522244665013507 0ustar liggesusers# # xts: eXtensible time-series # # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com # # Contributions from Joshua M. Ulrich # # 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, see . # fixes for R new/broken as.Date, as.POSIXlt and as.POSIXct # hopefully to be removed when remedied in R # taken directly from 'base', with origin set to '1970-01-01' (1970-01-01) `as.Date.numeric` <- function(x, origin='1970-01-01', ...) { as.Date(origin,...) + x } `as.POSIXct.numeric` <- function(x, tz="", origin='1970-01-01', ...) { structure(x, class=c("POSIXct", "POSIXt")) } `as.POSIXlt.numeric` <- function(x, tz="", origin='1970-01-01', ...) { as.POSIXlt(as.POSIXct(origin,tz="UTC",...) + x, tz=tz) } as.POSIXct.Date <- function(x, ...) { as.POSIXct(as.character(x)) } as.Date.POSIXct <- function(x, ...) { as.Date(strftime(x)) # z <- floor(unclass((x - unclass(as.POSIXct('1970-01-01'))))/86400) # attr(z, 'tzone') <- NULL # structure(z, class="Date") } as.POSIXlt.Date <- function(x, ...) { as.POSIXlt(as.POSIXct.Date(x)) } #as.POSIXct.yearmon <- function(x, ...) #{ # structure(as.POSIXct("1970-01-01") + unclass(as.Date(x))*86400, # class=c("POSIXct","POSIXt")) #} # #as.POSIXlt.yearmon <- function(x, ...) #{ # as.POSIXlt(xts:::as.POSIXct.yearmon(x)) #} # as.POSIXct.dates <- function(x, ...) { # need to implement our own method to correctly handle TZ #as.POSIXct(as.character(as.POSIXlt(x,tz="GMT"))) structure(as.POSIXct(as.POSIXlt(x, tz="GMT"), tz="GMT"),class=c("POSIXct","POSIXt")) } as.chron.POSIXct <- function(x, ...) { if(!requireNamespace('chron', quietly=TRUE)) as.chron <- function(...) message("package 'chron' required") structure(as.chron(as.POSIXlt(as.character(x)))) } xts/MD50000644000176200001440000002447714553240732011423 0ustar liggesusersfe73845d5fb870abe24af3cf0ac437f2 *DESCRIPTION 1ab51455998db14e45dfefd50c6f5752 *NAMESPACE 75e2affbc9021bfaed8ca10a51b72813 *NEWS a3f15cb729d860251bfbb8ddfc338b9e *R/Date.R 8f054b05f5ef9b9e5601d20f9d0b907d *R/Math.xts.R 383b8cc6bf360a22e8d80ed9abafc486 *R/OHLC.R e9f7b648bae3f6dc349aaff095c7b288 *R/Ops.xts.R 560f0304d0194323afb04d2da3758618 *R/POSIX.R 06c8900959ace6ed29e4c2497b867c30 *R/adj.time.R 3338860a36dd8605691f86eff8008be6 *R/align.time.R 719a384387f0229a76a1e28883bdfa62 *R/all.equal.R 3bdc88cb7dbeb631cce7f634f38c725a *R/as.environment.xts.R 0315be406636d3890f8c2291fa150044 *R/as.numeric.R ffcca9c07851f8d4420b7abe612c6ee1 *R/axTicksByTime.R c4ef4faee3f68e575c4af60176ddc70f *R/bind.R 4381d7aa8dd2030ba891fcaae6a17877 *R/coredata.xts.R af7566698ca3370e3e814b8556077d53 *R/data.frame.R e13db54c284ac131738943ca85ad0a00 *R/dimnames.R ae0e65fc483eb8934a60fc167fb0e355 *R/endpoints.R bc8dac1f89c727f9caf55aab54ae9d6e *R/fillIndex.R 49b62b6f4ee082bcde59a8a2f6f1f4dc *R/first.R 83a220c935fe03e46d57a3c30c8d748c *R/index.R 2790b5ac6f5ac1658c06b90bab09e105 *R/irts.R 31a60b92613af6b718256d0c9ecd4ed3 *R/isOrdered.R f7ed83ead2fff06783a2c48612c26e69 *R/lag.xts.R ef059792a6e45ed81c09b2f499a1b3c9 *R/last.R d4a42c602d0250187df151fef6990872 *R/list.R b6388313b2e4b158b20c9f9ef99d7fbe *R/matrix.R 0c93f7e3678102e457e71e6dbf43ce8e *R/merge.R fb8f9822aa4929b41f81bd3eea898750 *R/modify.args.R 81379c0bf64d20c238b07742b2c46021 *R/na.R e7af76f507e78b83488a2dd4849d9762 *R/nperiods.R f1e89591c22122cfc583897a85f67502 *R/origin.fix.R 654a263a89a2895f2c891d4d0772b67a *R/parse8601.R 909c8f7645017fe8271a6a217ec4e21f *R/period.R f853ce529e2c2ce7f82cd6be2a1df1ca *R/period.apply.R 0f16ddeb87cfed97cb60ee06ea1462bf *R/periodicity.R 401f786cdada6fb4f89223d652c0b83f *R/plot.R cc05b8ff02ac4c8c987f371e9ab19d86 *R/print.R 3fa5bcf2129b69d5c2199e1edafddcbf *R/rollapply.xts.R 114b6738367f91156a6deadafea9f8cf *R/sort.xts.R 9807eb129d25b635a69b67752c066dfa *R/split.R f2fd7d16c11b50235732df58583f76c3 *R/start.R b740af8fba26e151927aa48a1e752754 *R/startOfYear.R 42b226fe914763697f0c75e435afa347 *R/str.R f1c2d3743a2b4103de0a177b1fe1e2f4 *R/tclass.R 647fcd2d96db965365ee0f3db3251133 *R/tformat.R f19b50c1c39b018d306cb760cc886281 *R/timeBasedRange.R 3c2f282332883e62d19fa8eb27cda5df *R/timeBasedSeq.R d46b0e483e88a25285ed28100ec68a2c *R/timeDate.R 0b19dd835500a1772386a57713c07cea *R/timeSeries.R 417ecbdd37ef4dd66b3d40e23171c2d0 *R/toperiod.R f5c897a81423b04080a05c5a0eb94352 *R/ts.R e8e7dbaa3855ea84cffa521daa106ac1 *R/tzone.R 924a9eda408e0daac5adcf664da7a129 *R/utils.R 06221b45c4ff5ec06ce13cb1fd408cf3 *R/write.xts.R 4be9218c10f83fa0e8a1b633c0941f64 *R/xts.R 703352f3f97459a896b48aa02dbe9f37 *R/xts.methods.R c843b501caebd6f6abd20d490154e2cd *R/xtsible.R f74e70e98e7337aa15b3ff82e5e7327f *R/yearmon.R 3733678803c8e95cfa58463cf719cdd8 *R/zoo.R 199381c42e049d29ce95a4e37a0e69ce *R/zzz.R 0de36ee88abbb43254689cb05e340dc0 *build/vignette.rds e25f1e32e3b80ef3ff29d103a2c841c9 *data/sample_matrix.rda d273075b03c4d62b61a42ba4217bf49e *inst/api_example/DESCRIPTION 55d4cc70531955e6a4fd244e7d84c6c1 *inst/api_example/NAMESPACE 6497fbcaf2b3a892cb3dd0776a233dc6 *inst/api_example/R/checkOrder.R df23f6d544fca7b695962d1f4421bb99 *inst/api_example/README 09118e96879feba050a17474ceff8a8d *inst/api_example/man/checkOrder.Rd e24ef2161cbc80e1297fe776762ba86d *inst/api_example/man/linkXTS-package.Rd c0648d7cd58a619e37191ce4f80c6e9f *inst/api_example/src/checkOrder.c aaa8de0969962f40c9e2d069e115430c *inst/benchmarks/benchmark.subset.R e45027a27ff403b51af95ea2f1945d95 *inst/doc/xts-faq.R 71177aa2e5c7c8cf3cc3f91b5e635cfe *inst/doc/xts-faq.Rnw e8b315273b064c0b44261ee6f8788397 *inst/doc/xts-faq.pdf 3d81a4a65b40e6b1cd3cec726449d49d *inst/doc/xts.R ff730516ee7c76aaabb6b97bbb326b53 *inst/doc/xts.Rnw 782294ad539ad4ebe8695d49d9ec6efe *inst/doc/xts.pdf d415cb5e7772a846f462beaeaeb4aebf *inst/include/xts.h 086af5ee3a7aca5dfcaac1096ac4246d *inst/include/xtsAPI.h fb8b821627015068f6c24f22e183728a *inst/include/xts_stubs.c ca0456713e0804be8a3c74c37fabd9bd *inst/tinytest/runit.rowSums-rowMeans.R dce145c15320daf4a6b65e76a9fa5e18 *inst/tinytest/test-Ops.R e4406914c419f5e370c6481be56b6bb0 *inst/tinytest/test-align.time.R cb990770472c5bd58bea7ef19624d0d6 *inst/tinytest/test-all.equal.R 9a23ca91be43cb533e70b3ee7125d338 *inst/tinytest/test-binsearch.R 33e1cab561e827bcfc9c7d7668bac885 *inst/tinytest/test-coredata.R 84b4bb6b7855a074d3233a239abc6fc3 *inst/tinytest/test-data.frame.R 5867588c1558b0940d1906fc9ff20097 *inst/tinytest/test-diff.R ddade7a38f6c21542bdfd50ea2e26915 *inst/tinytest/test-dimnames.R 48a0394f33c87625f436c3af133c07ae *inst/tinytest/test-endpoints.R e8eb1428568d8bb2ae6e8b37ffb4ed92 *inst/tinytest/test-first-last.R 53d7177c598db078cb35dd52bbed43fb *inst/tinytest/test-index.R ef46414a4700a955d3b6dd23ef044245 *inst/tinytest/test-irts.R d1ea8d93f0a9f8ed68d6065262b81f22 *inst/tinytest/test-isordered.R cf9bfd641615dcb427934adf47859b43 *inst/tinytest/test-lag.R c95214b252e3204228dd12776b1f8a2c *inst/tinytest/test-matrix.R dbfe73c7604600fb3a5a00ce15a7426a *inst/tinytest/test-merge.R 6d05dc15e012ad76ca468fc08b65c65d *inst/tinytest/test-na.fill.R c34cbb79cf898c3e4e18cdb993824bd5 *inst/tinytest/test-na.locf.R 57ce6a9082199275ff24c3ab15df05d7 *inst/tinytest/test-na.omit.R 189e95e4940e6ea9fe9464e55f98923b *inst/tinytest/test-parseISO8601.R ba463b3d1841f34648b1f8e33a91974b *inst/tinytest/test-period.apply.R 939ea7f949fdeae74619591faea3f1f2 *inst/tinytest/test-periodicity.R 70a787661c83533b3f915c36a6e44be4 *inst/tinytest/test-plot.R 082f8b19f7b4e1ce38ca455a1b1d4e05 *inst/tinytest/test-print.R f032cdaac139a3ba5cdc2ee68ad4506c *inst/tinytest/test-reclass.R b6b66b3cfa0727eaf1def392611bd5d5 *inst/tinytest/test-split.R 270a4ad5c57f259f69244a2f90e40bee *inst/tinytest/test-subset-time-of-day.R 2579118f2d1df03150918ccb5475cc28 *inst/tinytest/test-subset.R 917eed127e060a2028d5c653da03f0a2 *inst/tinytest/test-tclass.R 2406e4f31af0d8b18720b19e33a356a9 *inst/tinytest/test-tformat.R 0b700524e0885b162f0536f8c892df63 *inst/tinytest/test-timeBasedSeq.R db8f51cd33ed4db2c324a95704e5316d *inst/tinytest/test-timeSeries.R 5ef6c25f551d5b7dee43d2ec7182bce7 *inst/tinytest/test-to.period.R 0ef61cea7a0d5818d57a84be6557d253 *inst/tinytest/test-ts.R 71a0014e95a45208e500ae88ccdd2809 *inst/tinytest/test-tzone.R 866a2d8b6ec3fa41316727f3366597d1 *inst/tinytest/test-xts.R 3f2a81d0c93d39369ad40fde049b5c57 *inst/tinytest/test-xts.methods.R c55d666140103d930dcd40754a28dd3c *inst/tinytest/test-zoo.R d86dd454a3ace15cc54f55f57819eb60 *man/CLASS.Rd 35a76c566f8c17c131bf4a16608222e7 *man/addEventLines.Rd 1b77283dd30cdc4e9875ad083c5f3f77 *man/addLegend.Rd da3a9997aaa66e6d722e1caac36a47e3 *man/addPanel.Rd 77bab46e15755957614a3d84bb95b486 *man/addPolygon.Rd d998fe9a31d61533e32ab93fa3ca8c73 *man/addSeries.Rd a8e9819419a640e9ee0eeab0e9bb45bb *man/align.time.Rd 4c74eadaf595af28c94bf263c9e62bf7 *man/apply.monthly.Rd 4211d430658cd710c88057f6006f6cbe *man/as.environment.Rd cd62b97e345df8578374e1d8220d0204 *man/as.xts.Rd 3dbb347e964b9e077899539ec6208570 *man/as.xts.methods.Rd ff5616f539b85f13cdbb468c06f9e971 *man/axTicksByTime.Rd fb2126e68715f6f9f6127c39e93c3eb4 *man/coredata.xts.Rd 4b14cc3f9018573762d44737fa12c30f *man/diff.Rd 313ebb0263535a867d6640705e708a14 *man/dimnames.xts.Rd bbdfa6d907bb98582ab74b4f5b22922c *man/endpoints.Rd 5183f5bec322d07d5f91c35f01c8927d *man/first.Rd fc0837c6af10e9de5c3502d5a5f869d3 *man/firstof.Rd 7af49dbdbd660a3e0e922f4f71e5164e *man/index.Rd 5a5700d85257411f02cf25a5e9686a2d *man/isOrdered.Rd ca3d5abe4db4fdb39f9ab697414a1b64 *man/make.index.unique.Rd a93d5d4043a51bfd337acf23fb1d3edd *man/merge.Rd 034983939ab5ba6f4671f85f76e675d7 *man/na.locf.xts.Rd 6b819569a0ce4d7ce155a124adfec848 *man/ndays.Rd 17df1c72965c703fa2cf2b8a5fc1bc12 *man/parseISO8601.Rd a97dc2f9cf7b95930cbe90f478e7a946 *man/period.apply.Rd 4d3f6667999a07973792ed096d85db53 *man/period.max.Rd c66b44b141d576245ca2f2440de76e7a *man/period.min.Rd eced87d9eb44887bfea2ef54af6f799e *man/period.prod.Rd ac9d9c7f84b62737272e88376ecec110 *man/period.sum.Rd aa66ea5ae6a3c001086cc8255e4ee0ce *man/periodicity.Rd ac519e6bcfcedd266c45732b8ff60e2f *man/plot.xts.Rd 33f2ecc82ed38e8988d95bca4bd12e19 *man/print.Rd 33ee7f0f4a540ffeee6f56e032f8e27b *man/rbind.xts.Rd 117e1cac129b3551c4a23f65b5c1db10 *man/sample.data.Rd ac032933c53a339d70b1015a4ad23b22 *man/split.Rd a7312388b874ec2e4a8601224bff9471 *man/subset.xts.Rd c47bde5333ef50336f5166e1cfaf8e83 *man/tclass.Rd 975e44b440c83d0b940123a139d5355e *man/tformat.Rd 88564ff2e25cd7360901036944b4d9f0 *man/timeBased.Rd a18af035405efd81d4710aafd9bf3521 *man/timeBasedSeq.Rd 579450395ee8322544a06c4e4a0ae576 *man/to.period.Rd c3d0065c44e021d6afda70ca05e2225f *man/tzone.Rd 6b5de110a0751cb80e414525e427f534 *man/window.xts.Rd 5af65263a40d7d2b81818df0fdb3d269 *man/xts-internals.Rd 0a96ac4732a227628c76a626b750c0d7 *man/xts-package.Rd fa0158d79950242251c519bb7a884483 *man/xts.Rd 3ecb27fbdede225f7537482390c058ad *man/xtsAPI.Rd a8587408f881a0c8b6f03f0145801b97 *man/xtsAttributes.Rd 3f03da795dd26373156bddc78d41e95d *src/Makevars 3f03da795dd26373156bddc78d41e95d *src/Makevars.win 6b0374aa67a0cb5dd38f879e708132b4 *src/add_class.c f485a4c5521e77204579b020f825bccc *src/any.c 352b7b0f1c8c49702baf9945fd20ff5f *src/attr.c d1eb6437796db5e54605264b1f3548cc *src/binsearch.c c91fe2075d20c8cf572452b7a69d4f5c *src/coredata.c c9aa1258d5793b5bde6e98974b9700b1 *src/dimnames.c 4d148e934a4f7b8c13d06f356f79e246 *src/endpoints.c 8976d5497755417b9b6eddf00b5d4349 *src/extract_col.c f76f72c7348fe190d1b22376df918d9a *src/init.c 5a1131c5c4cda826587411b399762e94 *src/isOrdered.c 6406378662cae4ddb780b572e3c207f5 *src/isXts.c 76eef6c210f46da6f0f43f388096b1a7 *src/lag.c 434e1628593323e2a2867374d63e60ea *src/merge.c 100daa62d01821334ed99b3d5a0667b2 *src/na.c da1b6df2c0b5b64c331335cf525dc143 *src/period_apply.c 98c3542c73b9d2e3bcb0874c93c199c8 *src/period_arithmetic.c 9d155812d858824aed442e88555e4e27 *src/period_quantile.c 1d7cd5483505427cfd2e6776e14d571f *src/rbind.c 7a60c01780f630c072175e7134ef08d9 *src/rollfun.c b6339594a3cf5d8dde13a6f9f771187c *src/runSum.c e0c8a91a3f89dc44f3d3033a3c7c8335 *src/startofyear.c 8b82aa3c1336652137236dfbdce1123c *src/subset.c 215a490e1edcdbf627eea9fe03f5359b *src/subset.old.c 0139eb8441e8dffcfc001dc33b1986e4 *src/toperiod.c 8b6df2194602bcec234c8840a3121e3e *src/totalcols.c 763d917b7ff58accceb96cd008116898 *src/tryXts.c ddcf2148cb8071a63182c5721e80b404 *src/unique.time.c 72514cfd44456eea7b95ba4701c92887 *tests/tinytest.R 71177aa2e5c7c8cf3cc3f91b5e635cfe *vignettes/xts-faq.Rnw ff730516ee7c76aaabb6b97bbb326b53 *vignettes/xts.Rnw xts/inst/0000755000176200001440000000000014552546765012070 5ustar liggesusersxts/inst/benchmarks/0000755000176200001440000000000014522244665014174 5ustar liggesusersxts/inst/benchmarks/benchmark.subset.R0000644000176200001440000000256714522244665017567 0ustar liggesusersstopifnot(require("xts")) stopifnot(require("microbenchmark")) # Benchmark [.xts using ISO8601 range on large objects N <- 2e7 s <- 86400*365.25 x <- .xts(1:N, 1.0*seq(s*20, s*40, length.out = N), tzone = "UTC") # warmup, in case there's any JIT for (i in 1:2) { x["1999/2001",] } profile <- FALSE if (profile) { # Use loop if profiling, so microbenchmark calls aren't included Rprof(line.profiling = TRUE) for(i in 1:10) { x[rng,] } Rprof(NULL) print(srp <- summaryRprof()) } else { cat("Subset using ISO-8601 range\n") microbenchmark(x["1990",], x["1990/",], x["/2009",], x["1990/1994",], x["1990/1999",], x["1990/2009",], times = 5) } cat("Subset using integer vector\n") i001 <- seq(1, N, 1) i005 <- seq(1, N, 5) i010 <- seq(1, N, 10) i050 <- seq(1, N, 50) i100 <- seq(1, N, 100) microbenchmark(x[i001,], x[i005,], x[i010,], x[i050,], x[i100,], times = 5) cat("Subset using logical vector\n") l001 <- l005 <- l010 <- l050 <- l100 <- logical(N) l001[i001] <- TRUE l005[i005] <- TRUE l010[i010] <- TRUE l050[i050] <- TRUE l100[i100] <- TRUE microbenchmark(x[l001,], x[l005,], x[l010,], x[l050,], x[l100,], times = 5) cat("Subset using date-time vector\n") t001 <- index(x)[i001] t005 <- index(x)[i005] t010 <- index(x)[i010] t050 <- index(x)[i050] t100 <- index(x)[i100] microbenchmark(x[t001,], x[t005,], x[t010,], x[t050,], x[t100,], times = 5) xts/inst/doc/0000755000176200001440000000000014552546765012635 5ustar liggesusersxts/inst/doc/xts.R0000644000176200001440000001251214552546765013577 0ustar liggesusers### R code from vignette source 'xts.Rnw' ################################################### ### code chunk number 1: a ################################################### require(xts) data(sample_matrix) class(sample_matrix) str(sample_matrix) matrix_xts <- as.xts(sample_matrix,dateFormat='Date') str(matrix_xts) df_xts <- as.xts(as.data.frame(sample_matrix), important='very important info!') str(df_xts) ################################################### ### code chunk number 2: xtsconstructor ################################################### xts(1:10, Sys.Date()+1:10) ################################################### ### code chunk number 3: xtsmethods (eval = FALSE) ################################################### ## matrix_xts['2007-03'] ################################################### ### code chunk number 4: xtsmethods-hidden ################################################### head(matrix_xts['2007-03'],5) cat('...\n') ################################################### ### code chunk number 5: xtsmethods2 (eval = FALSE) ################################################### ## matrix_xts['/2007-01-07'] ################################################### ### code chunk number 6: xtsmethods2-hidden ################################################### matrix_xts['/2007-01-07'] ################################################### ### code chunk number 7: xtsfirstandlast (eval = FALSE) ################################################### ## first(matrix_xts,'1 week') ################################################### ### code chunk number 8: xtsfirstandlast-hidden ################################################### head(first(matrix_xts,'1 week')) ################################################### ### code chunk number 9: xtsfirstandlast2 ################################################### first(last(matrix_xts,'1 week'),'3 days') ################################################### ### code chunk number 10: tclass ################################################### tclass(matrix_xts) tclass(convertIndex(matrix_xts,'POSIXct')) ################################################### ### code chunk number 11: xtsaxTicksByTime ################################################### axTicksByTime(matrix_xts, ticks.on='months') ################################################### ### code chunk number 12: xtsplot ################################################### plot(matrix_xts[,1],major.ticks='months',minor.ticks=FALSE,main=NULL,col=3) ################################################### ### code chunk number 13: asxtsreclass ################################################### # using xts-style subsetting doesn't work on non-xts objects sample_matrix['2007-06'] # convert to xts to use time-based subsetting str(as.xts(sample_matrix)['2007-06']) # reclass to get to original class back str(reclass(as.xts(sample_matrix)['2007-06'])) ################################################### ### code chunk number 14: usereclass ################################################### z <- zoo(1:10,Sys.Date()+1:10) # filter converts to a ts object - and loses the zoo class (zf <- filter(z, 0.2)) class(zf) # using Reclass, the zoo class is preserved (zf <- Reclass(filter(z, 0.2))) class(zf) ################################################### ### code chunk number 15: periodicity ################################################### periodicity(matrix_xts) ################################################### ### code chunk number 16: endpoints ################################################### endpoints(matrix_xts,on='months') endpoints(matrix_xts,on='weeks') ################################################### ### code chunk number 17: toperiod ################################################### to.period(matrix_xts,'months') periodicity(to.period(matrix_xts,'months')) # changing the index to something more appropriate to.monthly(matrix_xts) ################################################### ### code chunk number 18: periodapply ################################################### # the general function, internally calls sapply period.apply(matrix_xts[,4],INDEX=endpoints(matrix_xts),FUN=max) ################################################### ### code chunk number 19: applymonthly ################################################### # same result as above, just a monthly interface apply.monthly(matrix_xts[,4],FUN=max) ################################################### ### code chunk number 20: periodsum ################################################### # using one of the optimized functions - about 4x faster period.max(matrix_xts[,4], endpoints(matrix_xts)) ################################################### ### code chunk number 21: devtryxts ################################################### period.apply ################################################### ### code chunk number 22: attributes ################################################### str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) # attach some attributes xtsAttributes(matrix_xts) <- list(myattr="my meta comment") attr(matrix_xts, 'another.item') <- "one more thing..." str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) ################################################### ### code chunk number 23: subclass ################################################### xtssubclass <- structure(matrix_xts, class=c('xts2','xts','zoo')) class(xtssubclass) xts/inst/doc/xts.Rnw0000644000176200001440000010065414522244666014141 0ustar liggesusers%\VignetteIndexEntry{xts: Extensible Time Series} \documentclass{article} \usepackage{hyperref} \hypersetup{colorlinks,% citecolor=black,% linkcolor=blue,% urlcolor=blue,% } \title{\bf xts: Extensible Time Series } \author{Jeffrey A. Ryan \and Joshua M. Ulrich} \date{May 18, 2008} \begin{document} \maketitle \tableofcontents \section{Introduction} The statistical language {\tt R}~\cite{R} offers the time-series analyst a variety of mechanisms to both store and manage time-indexed data. Native {\tt R} classes potentially suitable for time-series data include {\tt data.frame}, {\tt matrix}, {\tt vector}, and {\tt ts} objects. Additional time-series tools have been subsequently introduced in contributed packages to handle some of the domain-specific shortcomings of the native {\tt R} classes. These include {\tt irts} from the {\tt tseries} package\cite{tseries}, {\tt timeSeries} from the {\tt Rmetrics} bundle\cite{rmetrics}, and {\tt zoo}~\cite{zoo} from their respective packages. Each of these contributed classes provides unique solution to many of the issues related to working with time-series in R. While it seems a bit paradoxical with all the current options available, what {\tt R} really needed was one more time-series class. Why? Users of R have had many choices over the years for managing time-series data. This variety has meant that developers have had to pick and choose the classes they would support, or impose the necessary conversions upon the end-user. With the sheer magnitude of software packages available from CRAN, it has become a challenge for users and developers to select a time-series class that will manage the needs of the individual user, as well as remain compatible with the broadest audience. What may be sufficient for one use --- say a quick correlation matrix may be too limiting when more information needs to be incorporated in a complex calculation. This is especially true for functions that rely on time-based indexes to be manipulated or checked. The previous solution to managing different data needs often involved a series of {\tt as} calls, to coerce objects from one type to another. While this may be sufficient for many cases, it is less flexible than allowing the users to simply use the object they are accustomed to, or quite possibly require. Additionally, all current coercion methods fail to maintain the original object's data in its entirety. Converting from a {\tt timeSeries} class to {\tt zoo} would cause attributes such as {\em FinCenter}, {\em format}, and {\em recordIDs} to be lost. Converting back to a {\tt timeSeries} would then add new values different than the original. For many calculations that do not modify the data, this is most likely an acceptable side effect. For functions that convert data --- such as {\tt xts}'s {\tt to.period} --- it limits the value of the function, as the returned object is missing much of what may have been a factor in the original class consideration. One of the most important additions the new {\tt xts} class makes to the R user's workflow doesn't use {\tt xts} at all, at least not explicitly. By converting data to {\tt xts} inside a function, the function developer is guaranteed to have to only manage a single class of objects. It becomes unecessary to write specific methods to handle different data. While many functions do have methods to accommodate different classes, most do not. Before {\tt xts}, the {\tt chartSeries} function in the {\tt quantmod} package\cite{quantmod} was only able to handle {\tt zoo} objects well. Work had been done to allow for {\tt timeSeries} objects to be used as well, but many issues were still being worked out. With {\tt xts} now used internally, it is possible to use \emph{any} of R's time-series classes. Simultaneously saving development time and reducing the learning/using curve for the end user. The function now simply handles whatever time-series object it receives exactly as the user expects --- without complaint. More details, as well as examples of incorporating {\tt xts} into functions will be covered later in this document. While it may seem that {\tt xts} is primarily a tool to help make existing R code more user-friendly, the opportunity to add exciting (to software people) new functionality could not be passed up. To this end, {\tt xts} offers the user the ability to add custom attributes to any object --- during its construction or at any time thereafter. Additionally, by requiring that the index attribute be derived from one of R's existing time-based classes, {\tt xts} methods can make assumptions, while subsetting by time or date, that allow for much cleaner and accurate data manipulation. The remainder of this introduction will examine what an {\tt xts} object consists of and its basic usage, explain how developing with {\tt xts} can save package development time, and finally will demonstrate how to extend the class - informally and formally. \pagebreak \section{The structure of {\tt xts}} To understand a bit more of \emph{what an xts object can do}, it may be beneficial to know \emph{what an xts object is}. This section is intended to provide a quick overview of the basics of the class, as well as what features make it unique. \subsection{It's a {\tt zoo} in here} At the core of an {\tt xts} object is a {\tt zoo} object from the package of the same name. Simplified, this class contains an array of values comprising your data (often in matrix form) and an index attribute to provide information about the data's ordering. Most of the details surrounding zoo objects apply equally to xts. As it would be redundent to simply retell the excellent introductory zoo vignette, the reader is advised to read, absorb, and re-read that documentation to best understand the power of this class. The authors of the {\tt xts} package recognize that {\tt zoo}'s strength comes from its simplicity of use, as well as its overall flexibility. What motivated the {\tt xts} extension was a desire to have even more flexibility, while imposing reasonable constraints to make this class into a true time-based one. \subsection{{\tt xts} modifications} Objects of class {\tt xts} differ from objects of class {\tt zoo} in three key ways: the use of formal time-based classes for indexing, internal xts properties, and perhaps most uniquely --- user-added attributes. \subsubsection*{True time-based indexes} To allow for functions that make use of {\tt xts} objects as a general time-series object - it was necessary to impose a simple rule on the class. The index of each {\tt xts} object \emph{must} be of a known and supported time or date class. At present this includes any one of the following - Date, POSIXct, chron, yearmon, yearqtr, or timeDate. The relative merits of each are left to the judgement of the user, though the first three are expected to be sufficient for most applications. \subsubsection*{Internal attributes: .CLASS, .ROWNAMES, etc.} In order for one major feature of the {\tt xts} class to be possible - the conversion and re-conversion of classes to and from {\tt xts} - certain elements must be preserved within the converted object. These are for internal use, and as such require little further explanation in an introductory document. Interested readers are invited to examine the source as well as read the developer documentation. \subsubsection*{xtsAttributes} This is what makes the xts class an \emph{extensible} time-series class. Arbitrary attributes may be assigned and removed from the object without causing issues with the data's display or otherwise. Additionally this is where \emph{other} class specific attributes (e.g. \emph{FinCenter} from {\tt timeSeries}) are stored during conversion to an xts object so they may be restored with {\tt reclass}. \pagebreak \section{Using the {\tt xts} package} Just what is required to start using {\tt xts}? Nothing more than a simple conversion of your current time-series data with {\tt as.xts}, or the creation of a new object with the {\tt xts} constructor. \subsection{Creating data objects: {\tt as.xts} and {\tt xts}} There are two equally valid mechanisms to create an {\tt xts} object - coerce a supported time-series class to {\tt xts} with a call to {\tt as.xts} or create a new object from scratch with {\tt xts}. \subsubsection*{Converting your \emph{existing} time-series data: {\tt as.xts}} If you are already comfortable using a particular time-series class in {\tt R}, you can still access the functionality of {\tt xts} by converting your current objects. Presently it is possible to convert all the major time-series like classes in {\tt R} to {\tt xts}. This list includes objects of class: matrix, data.frame, ts, zoo, irts, and timeSeries. The new object will maintain all the necessary information needed to {\tt reclass} this object back to its original class if that is desired. Most classes after re-conversion will be identical to similar modifications on the original object, even after sub-setting or other changes while an {\tt xts} object. <>= require(xts) data(sample_matrix) class(sample_matrix) str(sample_matrix) matrix_xts <- as.xts(sample_matrix,dateFormat='Date') str(matrix_xts) df_xts <- as.xts(as.data.frame(sample_matrix), important='very important info!') str(df_xts) @ A few comments about the above. {\tt as.xts} takes different arguments, depending on the original object to be converted. Some classes do not contain enough information to infer a time-date class. If that is the case, POSIXct is used by default. This is the case with both matrix and data.frame objects. In the preceding examples we first requested that the new date format be of type 'Date'. The second example was left to the default {\tt xts} method with a custom attribute added. \subsubsection*{Creating new data: the {\tt xts} constructor} Data objects can also be constructed directly from raw data with the {\tt xts} constructor function, in essentially the same way a {\tt zoo} object is created with the exception that at present there is no equivelant {\tt zooreg} class. <>= xts(1:10, Sys.Date()+1:10) @ \subsection{{\tt xts} methods} There is a full complement of standard methods to make use of the features present in {\tt xts} objects. The generic methods currently extended to {\tt xts} include ``{\tt [}'', {\tt cbind}, {\tt rbind}, {\tt c}, {\tt str}, {\tt Ops}, {\tt print}, {\tt na.omit}, {\tt time}, {\tt index}, {\tt plot} and {\tt coredata}. In addition, most methods that can accept zoo or matrix objects will simply work as expected. A quick tour of some of the methods leveraged by {\tt xts} will be presented here, including subsetting via ``{\tt [}'', indexing objects with {\tt tclass} and {\tt convertIndex}, and a quick look at plotting {\tt xts} objects with the {\tt plot} function. \subsubsection*{Subsetting} The most noticable difference in the behavior of \texttt{xts} objects will be apparent in the use of the ``{\tt [}'' operator. Using special notation, one can use date-like strings to extract data based on the time-index. Using increasing levels of time-detail, it is possible to subset the object by year, week, days - or even seconds. The {\em i} (row) argument to the subset operator ``{\tt [}'', in addition to accepting numeric values for indexing, can also be a character string, a time-based object, or a vector of either. The format must left-specified with respect to the standard ISO:8601 time format --- {\em ``CCYY-MM-DD HH:MM:SS''}~\cite{ISO}. This means that for one to extract a particular month, it is necesssary to fully specify the year as well. To identify a particular hour, say all observations in the eighth hour on January 1, 2007, one would likewise need to include the full year, month and day - e.g. ``2007-01-01 08''. It is also possible to explicitly request a range of times via this index-based subsetting, using the ISO-recommended ``/'' as the range seperater. The basic form is {\em ``from/to''}, where both {\em from} and {\em to} are optional. If either side is missing, it is interpretted as a request to retrieve data from the beginning, or through the end of the data object. Another benefit to this method is that exact starting and ending times need not match the underlying data - the nearest available observation will be returned that is within the requested time period. The following example shows how to extract the entire month of March 2007 - without having to manually identify the index positions or match the underlying index type. The results have been abbreviated to save space. <>= matrix_xts['2007-03'] @ <>= head(matrix_xts['2007-03'],5) cat('...\n') @ Now extract all the data from the beginning through January 7, 2007. <>= matrix_xts['/2007-01-07'] @ <>= matrix_xts['/2007-01-07'] @ Additional xts tools providing subsetting are the {\tt first} and {\tt last} functions. In the spirit of head and tail from the {\em utils} recommended package, they allow for string based subsetting, without forcing the user to conform to the specifics of the time index, similar in usage to the {\em by} arguments of {\tt aggregate.zoo} and {\tt seq.POSIXt}. Here is the first 1 week of the data <>= first(matrix_xts,'1 week') @ <>= head(first(matrix_xts,'1 week')) @ ...and here is the first 3 days of the last week of the data. <>= first(last(matrix_xts,'1 week'),'3 days') @ \subsubsection*{Indexing} While the subsetting ability of the above makes exactly {\em which} time-based class you choose for your index a bit less relevant, it is none-the-less a factor that is beneficial to have control over. To that end, {\tt xts} provides facilities for indexing based on any of the current time-based classes. These include {\tt Date}, {\tt POSIXct}, {\tt chron}, {\tt yearmon}, {\tt yearqtr}, and {\tt timeDate}. The index itself may be accessed via the zoo generics extended to xts --- {\tt index} and the replacement function {\tt index<-}. It is also possible to directly query and set the index class of an {\tt xts} object by using the respective functions {\tt tclass} and {\tt tclass<-}. Temporary conversion, resulting in a new object with the requested index class, can be accomplished via the {\tt convertIndex} function. <>= tclass(matrix_xts) tclass(convertIndex(matrix_xts,'POSIXct')) @ \pagebreak \subsubsection*{Plotting} \SweaveOpts{height=5,width=10} %\setkeys{Gin}{width=0.8\textwidth} The use of time-based indexes within {\tt xts} allows for assumptions to be made regarding the x-axis of plots. The {\tt plot} method makes use of the {\tt xts} function {\tt axTicksByTime}, which heuristically identifies suitable tickmark locations for printing given a time-based object. When {\tt axTickByTime} is called with its {\tt ticks.on} argument set to ``auto'', the result is a vector of suitably chosen tickmark locations. One can also specify the specific points to use by passing a character string to the argument indicating which time period to create tickmarks on. <>= axTicksByTime(matrix_xts, ticks.on='months') @ A simple example of the plotting functionality offered by this labelling can be seen here: \begin{center} <>= plot(matrix_xts[,1],major.ticks='months',minor.ticks=FALSE,main=NULL,col=3) @ \end{center} \subsection{Restoring the original class - {\tt reclass} \& {\tt Reclass}} By now you may be interested in some of the xts functionality presented, and wondering how to incorporate it into a current workflow --- but not yet ready to commit to using it exclusively. If it is desirable to only use the subsetting tools for instance, a quick conversion to xts via {\tt as.xts} will allow full access to the above subsetting tools. When it is then necessary to continue your analysis using the original class, it is as simple as calling the function {\tt reclass} to return the object to its original class. \subsubsection*{(Re)converting classes manually: {\tt reclass}} <>= # using xts-style subsetting doesn't work on non-xts objects sample_matrix['2007-06'] # convert to xts to use time-based subsetting str(as.xts(sample_matrix)['2007-06']) # reclass to get to original class back str(reclass(as.xts(sample_matrix)['2007-06'])) @ This differs dramatically from the standard {\tt as.*****} conversion though. Internally, key attributes of your original data object are preserved and adjusted to assure that the process introduces no changes other than those requested. Think of it as a smart {\tt as}. Behind the scenes, {\tt reclass} has enormous value in functions that convert all incoming data to {\tt xts} for simplified processing. Often it is necessary to return an object back to the user in the class he is expecting --- following the principal of least surprise. It is in these circumstances where {\tt reclass} can turn hours of tedious development into mere minutes per function. More details on the details of using this functionality for developers will be covered in section \ref{developer}, \textbf{Developing with xts}. A user friendly interface of this \emph{reclass} functionality, though implicit, is available in the {\tt Reclass} function. It's purpose is to make it easy to preserve an object's attributes after calling a function that is not programmed to be aware of your particular class. \pagebreak \subsubsection*{Letting xts handle the details: {\tt Reclass}} If the function you require does not make use of {\tt reclass} internally, it may still be possible to let xts convert and reconvert your time-based object for you. The caveat here is that the object returned: \begin{quote} \begin{itemize} \item must be of the same length as the first argument to the function. \item intended to be coerced back to the class of the first argument \end{itemize} \end{quote} Simply wrapping the function that meets these criteria in {\tt Reclass} will result in an attempt to coerce the returned output of the function <>= z <- zoo(1:10,Sys.Date()+1:10) # filter converts to a ts object - and loses the zoo class (zf <- filter(z, 0.2)) class(zf) # using Reclass, the zoo class is preserved (zf <- Reclass(filter(z, 0.2))) class(zf) @ The {\tt Reclass} function is still a bit experimental, and will certainly improve in time, but for now provides at least an alternative option to maintain your object's class and attributes when the function you require can't on its own. \subsection{Additional time-based tools} In addition to the core {\tt xts} tools covered above, there are more functions that are included in xts to make the process of dealing with time-series data easier. Some of these have been moved from the package {\tt quantmod} to {\tt xts} to make it easier to use them within other applications. \subsubsection*{Calculate periodicity} The {\tt periodicity} function provides a quick summary as to the underlying periodicity of most time-series like objects. Primarily a wrapper to {\tt difftime} it provides a quick and concise summary of your data. <>= periodicity(matrix_xts) @ \subsubsection*{Find endpoints by time} Another common issue with time-series data is identifying the endpoints with respect to time. Often it is necessary to break data into hourly or monthly intervals to calculate some statistic. A simple call to {\tt endpoints} offers a quick vector of values suitable for subsetting a dataset by. Note that the first element it zero, which is used to delineate the \emph{end}. <>= endpoints(matrix_xts,on='months') endpoints(matrix_xts,on='weeks') @ \subsubsection*{Change periodicity} One of the most ubiquitous type of data in finance is OHLC data (Open-High-Low-Close). Often is is necessary to change the periodicity of this data to something coarser - e.g. take daily data and aggregate to weekly or monthly. With {\tt to.period} and related wrapper functions it is a simple proposition. <>= to.period(matrix_xts,'months') periodicity(to.period(matrix_xts,'months')) # changing the index to something more appropriate to.monthly(matrix_xts) @ The {\tt to.monthly} wrapper automatically requests that the returned object have an index/rownames using the {\tt yearmon} class. With the {\tt indexAt} argument it is possible to align most series returned to the end of the period, the beginning of the period, or the first or last observation of the period --- even converting to something like {\tt yearmon} is supported. The online documentation provides more details as to additional arguments. \subsubsection*{Periodically apply a function} Often it is desirable to be able to calculate a particular statistic, or evaluate a function, over a set of non-overlapping time periods. With the {\tt period.apply} family of functions it is quite simple. The following examples illustrate a simple application of the {\tt max} function to our example data. <>= # the general function, internally calls sapply period.apply(matrix_xts[,4],INDEX=endpoints(matrix_xts),FUN=max) @ <>= # same result as above, just a monthly interface apply.monthly(matrix_xts[,4],FUN=max) @ <>= # using one of the optimized functions - about 4x faster period.max(matrix_xts[,4], endpoints(matrix_xts)) @ In addition to {\tt apply.monthly}, there are wrappers to other common time frames including: {\tt apply.daily}, {\tt apply.weekly}, {\tt apply.quarterly}, and {\tt apply.yearly}. Current optimized functions include {\tt period.max}, {\tt period.min}, {\tt period.sum}, and {\tt period.prod}. \pagebreak \section{Developing with {\tt xts}} \label{developer} While the tools available to the xts \emph{user} are quite useful, possibly greater utility comes from using xts internally as a \emph{developer}. Bypassing traditional S3/S4 method dispatch and custom if-else constructs to handle different time-based classes, {\tt xts} not only makes it easy to handle all supported classes in one consistent manner, it also allows the whole process to be invisible to the function user. \subsection{One function for all classes: {\tt try.xts}} With the proliferation of data classes in R, it can be tedious, if not entirely impractical, to manage interfaces to all classes. Not only does trying to handle every possible class present non-trivial design issues, the developer is also forced to learn and understand the nuances of up to eight or more classes. For each of these classes it is then ncessary to write and manage corresponding methods for each case. At best, this reduces the time available to devote to core function functionality --- at worst is a prime opportunity to introduce errors that inevitibly come from this massive increase in code. The solution to this issue is to use one class internally within your package, or more generally your entire workflow. This can be accomplished in one of two ways: force your users to adopt the convention you do, or allow for multiple object classes by relying on internal code to convert to one consistent type. Using the second approach offers the most end-user flexibility, as class conversions are no longer required simply to make use of package functionality. The user's own workflow need not be interrupted with unproductive and potentially error-prone conversions and reconversions. Using the functionality of {\tt try.xts} and {\tt reclass} offered by the xts package allows the developer an opportunity to cleanly, and reliably, manage data with the least amount of code, and the least number of artificial end-user restrictions. An example from the xts package illustrates just how simple this can be. <>= period.apply @ Some explanation of the above code is needed. The {\tt try.xts} function takes three arguments, the first is the object that the developer is trying to convert, the second \ldots is any additional arguments to the {\tt as.xts} constructor that is called internally (ignore this for the most part --- though it should be noted that this is an R dots argument \ldots), and the third is a what the result of an error should be. Of the three, {\tt error} is probably the most useful from a design standpoint. Some functions may not be able to deal with data that isn't time-based. Simple numerical vectors might not contain enough information to be of any use. The \emph{error} argument lets the developer decide if the function should be halted at this point, or continue onward. If a logical value, the result is handled by R's standard error mechanism during the try-catch block of code internal to {\tt try.xts}. If error is a character string, it is returned to the standard output as the message. This allows for diagnostic messages to be fine tuned to your particular application. The result of this call, if successful (or if {\tt error=FALSE}) is an object that may be of class {\tt xts}. If your function can handle either numeric data or time-based input, you can branch code here for cases you expect. If your code has been written to be more general at this point, you can simply continue with your calculations, the originally converted object will contain the information that will be required to reclass it at the end. A note of importance here: if you are planning on returning an object that is of the original class, it is important to not modify the originally coverted object - in this case that would be the {\tt x} result of the {\tt try.xts} call. You will notice that the function's result is assigned to {\tt xx} so as not to impact the original converted function. If this is not possible, it is recommended to copy the object first to preserve an untouched copy for use in the {\tt reclass} function. Which leads to the second part of the process of developing with xts. \subsection{Returning the original class: {\tt reclass}} The {\tt reclass} function takes the object you are expecting to return to your user (the result of all your calculations) and optionally an {\tt xts} object that was the result of the original {\tt try.xts} call. It is important to stress that the {\tt match.to} object \emph{must be an untouched object} returned from the {\tt try.xts} call. The only exception here is when the resultant data has changed dimension --- as is the case in the {\tt period.apply} example. As reclass will try and convert the first argument to the orginal class of the second (the original class passed to the function), it must have the same general row dimension of the original. A final note on using {\tt reclass}. If the {\tt match.to} argument is left off, the conversion will only be attempted if the object is of class {\tt xts} and has a {\tt CLASS} attribute that is not {\tt NULL}, else the object is simply returned. Essentially if the object meant to be reconverted is already of in the form needed by the individual reclass methods, generally nothing more needs to be done by the developer. In many cases your function does not need to return an object that is expected to be used in the same context as the original. This would be the case for functions that summarize an object, or perform some statistical analysis. For functions that do not need the {\tt reclass} functionality, a simple use of {\tt try.xts} at the beginning of the function is all that is needed to make use of this single-interface tool within {\tt xts}. Further examples can be found in the {\tt xts} functions {\tt periodicity} and {\tt endpoints} (no use of reclass), and {\tt to.period} (returns an object of the original's class). The package {\tt quantmod} also utilizes the {\tt try.xts} functionality in its {\tt chartSeries} function --- allowing financial charts for all time-based classes. Forthcoming developer documentation will examine the functions highlighted above, as well go into more detail on exceptional cases and requirements. \pagebreak \section{Customizing and Extending xts} As \emph{extensible} is in the name of the package, it is only logical that it can be extended. The two obvious mechanisms to make {\tt xts} match the individual needs of a diverse user base is the introduction of custom attributes, and the idea of subclassing the entire {\tt xts} class. \subsection{{\tt xtsAttributes}} What makes an R attribute an {\tt xtsAttribute}? Beyond the sematics, xtsAttributes are designed to persist once attached to an object, as well as not get in the way of other object functionality. All xtsAttributes are indeed R attributes, though the same can not be said of the reverse --- all R attributes are \emph{not} xtsAttributes! Attaching arbitrary attributes to most (all?) classes other than {\tt xts} will cause the attribute to be displayed during most calls that print the object. While this isn't necessarily devestating, it is often time unsightly, and sometimes even confusing to the end user (this may depend on the quality your users). xts offers the developer and end-user the opportunity to attach attributes with a few different mechanisms - and all will be suppressed from normal view, unless specifically called upon. What makes an xtsAttribute special is that it is principally a mechanism to store and view meta-data, that is, attributes that would be seen with a call to R's {\tt attributes}. <>= str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) # attach some attributes xtsAttributes(matrix_xts) <- list(myattr="my meta comment") attr(matrix_xts, 'another.item') <- "one more thing..." str(attributes(matrix_xts)) str(xtsAttributes(matrix_xts)) @ In general - the only attributes that should be handled directly by the user (\emph{without} the assistance of xts functions) are ones returned by {\tt xtsAttributes}. The additional attributes seen in the {\tt attributes} example are for internal R and xts use, and if you expect unbroken code, should be left alone. \subsection{Subclassing {\tt xts}} Subclassing xts is as simple as extending any other S3 class in R. Simply include the full class of the xts system in your new class. <>= xtssubclass <- structure(matrix_xts, class=c('xts2','xts','zoo')) class(xtssubclass) @ This will allow the user to override methods of xts and zoo, while still allowing for backward compatibility with all the tools of xts and zoo, much the way {\tt xts} benefits from extending {\tt zoo}. \section{Conclusion} The {\tt xts} package offers both R developers and R users an extensive set of time-aware tools for use in time-based applications. By extending the {\tt zoo} class, xts leverages an excellent infrastructure tool into a true time-based class. This simple requirement for time-based indexing allows for code to make assumptions about the object's purpose, and facilitates a great number of useful utilities --- such as time-based subsetting. Additionally, by embedding knowledge of the currently used time-based classes available in R, xts can offer the developer and end-user a single interface mechanism to make internal class decisions user-driven. This affords developers an opportunity to design applications for there intended purposes, while freeing up time previously used to manage the data structures. Future development of xts will focus on integrating xts into more external packages, as well as additional useful additions to the time-based utilities currently available within the package. An effort to provide external disk and memory based data access will also be examined for potential inclusion or extension. \begin{thebibliography}{99} \bibitem{zoo} Achim Zeileis and Gabor Grothendieck (2005): \emph{ zoo: S3 Infrastructure for Regular and Irregular Time Series.} Journal of Statistical Software, 14(6), 1-27. URL http://www.jstatsoft.org/v14/i06/ \bibitem{tseries} Adrian Trapletti and Kurt Hornik (2007): \emph{tseries: Time Series Analysis and Computational Finance.} R package version 0.10-11. \bibitem{rmetrics} Diethelm Wuertz, many others and see the SOURCE file (2007): \emph{Rmetrics: Rmetrics - Financial Engineering and Computational Finance.} R package version 260.72. http://www.rmetrics.org \bibitem{ISO} International Organization for Standardization (2004): \emph{ISO 8601: Data elements and interchage formats --- Information interchange --- Representation of dates and time} URL http://www.iso.org \bibitem{R} R Development Core Team: \emph{R: A Language and Environment for Statistical Computing}, R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, URL http://www.R-project.org \bibitem{quantmod} Jeffrey A. Ryan (2008): \emph{quantmod: Quantitative Financial Modelling Framework.} R package version 0.3-5. URL http://www.quantmod.com URL http://r-forge.r-project.org/projects/quantmod \end{thebibliography} \end{document} xts/inst/doc/xts-faq.Rnw0000644000176200001440000003005414525744640014702 0ustar liggesusers%\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} %% -*- encoding: utf-8 -*- %\VignetteIndexEntry{xts FAQ} %\VignetteDepends{zoo} \documentclass{article} % \usepackage{Rd} \usepackage{Sweave} \usepackage{hyperref} \hypersetup{colorlinks,% citecolor=black,% linkcolor=blue,% urlcolor=blue,% } %%\encoding{UTF-8} %%\usepackage[UTF-8]{inputenc} % \newcommand{\q}[1]{\section*{#1}\addcontentsline{toc}{subsection}{#1}} \author{xts Deveopment Team% \footnote{Contact author: Joshua M. Ulrich \email{josh.m.ulrich@gmail.com}} \footnote{Thanks to Alberto Giannetti and Michael R. Weylandt for their many contributions.} } \title{\bf xts FAQ} %\Keywords{irregular time series, time index, daily data, weekly data, returns} %\Abstract{ % This is a collection of frequently asked questions (FAQ) about the % \pkg{xts} package together with their answers. %} \begin{document} \SweaveOpts{concordance=TRUE, engine=R, eps=FALSE} %\SweaveOpts{engine=R, eps=FALSE} <>= library("xts") Sys.setenv(TZ="GMT") @ \makeatletter \makeatother \maketitle \tableofcontents \q{What is \pkg{xts}?} % \pkg{xts} is an \pkg{R} package offering a number of functionalities to work on time-indexed data. \pkg{xts} extends \pkg{\pkg{zoo}}, another popular package for time-series analysis. % should point to the zoo FAQ here (or at some early point) \q{Why should I use \pkg{xts} rather than \pkg{zoo} or another time-series package?} % The main benefit of \pkg{xts} is its seamless compatibility with other packages using different time-series classes (\pkg{timeSeries}, \pkg{zoo}, ...). In addition, \pkg{xts} allows the user to add custom attributes to any object. See the main \pkg{xts} vignette for more information. \q{How do I install \pkg{xts}?} % \pkg{xts} depends on \pkg{zoo} and suggests some other packages. You should be able to install \pkg{xts} and all the other required components by simply calling \code{install.packages('pkg')} from the \pkg{R} prompt. \q{I have multiple .csv time-series files that I need to load in a single \pkg{xts} object. What is the most efficient way to import the files?} % If the files have the same format, load them with \code{read.zoo} and then call \code{rbind} to join the series together; finally, call \code{as.xts} on the result. Using a combination of \code{lapply} and \code{do.call} can accomplish this with very little code: <>= filenames <- c("a.csv", "b.csv", "c.csv") sample.xts <- as.xts(do.call("rbind", lapply(filenames, read.zoo))) @ \q{Why is \pkg{xts} implemented as a matrix rather than a data frame?} % \pkg{xts} uses a matrix rather than data.frame because: \begin{enumerate} \item \pkg{xts} is a subclass of \pkg{zoo}, and that's how \pkg{zoo} objects are structured; and \item matrix objects have much better performance than data.frames. \end{enumerate} \q{How can I simplify the syntax when referring to \pkg{xts} object column names?} % \code{with} allows you to use the colmn names while avoiding the full square brackets syntax. For example: <>= lm(sample.xts[, "Res"] ~ sample.xts[, "ThisVar"] + sample.xts[, "ThatVar"]) @ can be converted to <>= with(sample.xts, lm(Res ~ ThisVar + ThatVar)) @ \q{How can I replace the zeros in an \pkg{xts} object with the last non-zero value in the series?} % Convert the zeros to \code{NA} and then use \code{na.locf}: <<>>= sample.xts <- xts(c(1:3, 0, 0, 0), as.POSIXct("1970-01-01")+0:5) sample.xts[sample.xts==0] <- NA cbind(orig=sample.xts, locf=na.locf(sample.xts)) @ \q{How do I create an \pkg{xts} index with millisecond precision?} % Milliseconds in \pkg{xts} indexes are stored as decimal values. This example builds an index spaced by 100 milliseconds, starting at the current system time: <<>>= data(sample_matrix) sample.xts <- xts(1:10, seq(as.POSIXct("1970-01-01"), by=0.1, length=10)) @ \q{I have a millisecond-resolution index, but the milliseconds aren't displayed. What went wrong?} % Set the \code{digits.secs} option to some sub-second precision. Continuing from the previous example, if you are interested in milliseconds: <<>>= options(digits.secs=3) head(sample.xts) @ \q{I set \code{digits.sec=3}, but \pkg{R} doesn't show the values correctly.} % Sub-second values are stored with approximately microsecond precision. Setting the precision to only 3 decimal hides the full index value in microseconds and might be tricky to interpret depending how the machine rounds the millisecond (3rd) digit. Set the \code{digits.secs} option to a value higher than 3 or convert the date-time to numeric and use \code{print}'s \code{digits} argument, or \code{sprintf} to display the full value. For example: <<>>= dt <- as.POSIXct("2012-03-20 09:02:50.001") print(as.numeric(dt), digits=20) sprintf("%20.10f", dt) @ \q{I am using \code{apply} to run a custom function on my \pkg{xts} object. Why does the returned matrix have different dimensions than the original one?} % When working on rows, \code{apply} returns a transposed version of the original matrix. Simply call \code{t} on the returned matrix to restore the original dimensions: <>= sample.xts.2 <- xts(t(apply(sample.xts, 1, myfun)), index(sample.xts)) @ \q{I have an \pkg{xts} object with varying numbers of observations per day (e.g., one day might contain 10 observations, while another day contains 20 observations). How can I apply a function to all observations for each day?} % You can use \code{apply.daily}, or \code{period.apply} more generally: <<>>= sample.xts <- xts(1:50, seq(as.POSIXct("1970-01-01"), as.POSIXct("1970-01-03")-1, length=50)) apply.daily(sample.xts, colMeans) period.apply(sample.xts, endpoints(sample.xts, "days"), colMeans) period.apply(sample.xts, endpoints(sample.xts, "hours", 6), colMeans) @ \q{How can I process daily data for a specific time subset?} % First use time-of-day subsetting to extract the time range you want to work on (note the leading \code{"T"} and leading zeros are required for each time in the range: \code{"T06:00"}), then use \code{apply.daily} to apply your function to the subset: <>= apply.daily(sample.xts['T06:00/T17:00',], colMeans) @ \q{How can I analyze my irregular data in regular blocks, adding observations for each regular block if one doesn't exist in the origianl time-series object?} % Use \code{align.time} to round-up the indexes to the periods you are interested in, then call \code{period.apply} to apply your function. Finally, merge the result with an empty xts object that contains all the regular index values you want: <<>>= sample.xts <- xts(1:6, as.POSIXct(c("2009-09-22 07:43:30", "2009-10-01 03:50:30", "2009-10-01 08:45:00", "2009-10-01 09:48:15", "2009-11-11 10:30:30", "2009-11-11 11:12:45"))) # align index into regular (e.g. 3-hour) blocks aligned.xts <- align.time(sample.xts, n=60*60*3) # apply your function to each block count <- period.apply(aligned.xts, endpoints(aligned.xts, "hours", 3), length) # create an empty xts object with the desired regular index empty.xts <- xts(, seq(start(aligned.xts), end(aligned.xts), by="3 hours")) # merge the counts with the empty object head(out1 <- merge(empty.xts, count)) # or fill with zeros head(out2 <- merge(empty.xts, count, fill=0)) @ \q{Why do I get a \pkg{zoo} object when I call \code{transform} on my \pkg{xts} object?} % There's no \pkg{xts} method for \code{transform}, so the \pkg{zoo} method is dispatched. The \pkg{zoo} method explicitly creates a new \pkg{zoo} object. To convert the transformed object back to an \pkg{xts} object wrap the \code{transform} call in \code{as.xts}: <>= sample.xts <- as.xts(transform(sample.xts, ABC=1)) @ You might also have to reset the index timezone: <>= tzone(sample.xts) <- Sys.getenv("TZ") @ \q{Why can't I use the \code{\&} operator in \pkg{xts} objects when querying dates?} % \code{"2011-09-21"} is not a logical vector and cannot be coerced to a logical vector. See \code{?"\&"} for details. \pkg{xts}' ISO-8601 style subsetting is nice, but there's nothing we can do to change the behavior of \code{.Primitive("\&")}. You can do something like this though: <>= sample.xts[sample.xts$Symbol == "AAPL" & index(sample.xts) == as.POSIXct("2011-09-21"),] @ or: <>= sample.xts[sample.xts$Symbol == "AAPL"]['2011-09-21'] @ \q{How do I subset an \pkg{xts} object to only include weekdays (excluding Saturday and Sundays)?} % Use \code{.indexwday} to only include Mon-Fri days: <<>>= data(sample_matrix) sample.xts <- as.xts(sample_matrix) wday.xts <- sample.xts[.indexwday(sample.xts) %in% 1:5] head(wday.xts) @ \q{I need to quickly convert a data.frame that contains the time-stamps in one of the columns. Using \code{as.xts(Data)} returns an error. How do I build my \pkg{xts} object?} % The \code{as.xts} function assumes the date-time index is contained in the \code{rownames} of the object to be converted. If this is not the case, you need to use the \code{xts} constructor, which requires two arguments: a vector or a matrix carrying data and a vector of type \code{Date}, \code{POSIXct}, \code{chron}, \ldots, supplying the time index information. If you are certain the time-stamps are in a specific column, you can use: <<>>= Data <- data.frame(timestamp=as.Date("1970-01-01"), obs=21) sample.xts <- xts(Data[,-1], order.by=Data[,1]) @ If you aren't certain, you need to explicitly reference the column name that contains the time-stamps: <<>>= Data <- data.frame(obs=21, timestamp=as.Date("1970-01-01")) sample.xts <- xts(Data[,!grepl("timestamp",colnames(Data))], order.by=Data$timestamp) @ \q{I have two time-series with different frequency. I want to combine the data into a single \pkg{xts} object, but the times are not exactly aligned. I want to have one row in the result for each ten minute period, with the time index showing the beginning of the time period.} % \code{align.time} creates evenly spaced time-series from a set of indexes, \code{merge} ensure two time-series are combined in a single \pkg{xts} object with all original columns and indexes preserved. The new object has one entry for each timestamp from both series and missing values are replaced with \code{NA}. <>= x1 <- align.time(xts(Data1$obs, Data1$timestamp), n=600) x2 <- align.time(xts(Data2$obs, Data2$timestamp), n=600) merge(x1, x2) @ \q{Why do I get a warning when running the code below?} <<>>= data(sample_matrix) sample.xts <- as.xts(sample_matrix) sample.xts["2007-01"]$Close <- sample.xts["2007-01"]$Close + 1 #Warning message: #In NextMethod(.Generic) : # number of items to replace is not a multiple of replacement length @ % This code creates two calls to the subset-replacement function \code{xts:::`[<-.xts`}. The first call replaces the value of \code{Close} in a temporary copy of the first row of the object on the left-hand-side of the assignment, which works fine. The second call tries to replace the first \emph{element} of the object on the left-hand-side of the assignment with the modified temporary copy of the first row. This is the problem. For the command to work, there needs to be a comma in the first subset call on the left-hand-side: <>= sample.xts["2007-01",]$Close <- sample.xts["2007-01"]$Close + 1 @ This isn't encouraged, because the code isn't clear. Simply remember to subset by column first, then row, if you insist on making two calls to the subset-replacement function. A cleaner and faster solution is below. It's only one function call and it avoids the \code{\$} function (which is marginally slower on xts objects). <>= sample.xts["2007-01","Close"] <- sample.xts["2007-01","Close"] + 1 @ %%% What is the fastest way to subset an xts object? \end{document} xts/inst/doc/xts-faq.pdf0000644000176200001440000036620514552546764014726 0ustar liggesusers%PDF-1.5 % 88 0 obj << /Length 549 >> stream concordance:xts-faq.tex:xts-faq.Rnw:1 47 1 1 5 34 1 1 2 1 0 1 1 3 0 1 2 13 1 1 2 4 0 2 2 4 0 1 2 4 1 1 2 1 0 2 1 12 0 1 2 4 1 1 2 1 0 1 1 3 0 1 2 5 1 1 2 1 0 1 1 12 0 1 2 8 1 1 2 1 0 1 1 5 0 1 1 6 0 1 2 6 1 1 2 4 0 1 2 5 1 1 3 2 0 1 1 7 0 1 1 7 0 1 1 14 0 1 2 5 1 1 2 4 0 1 2 7 1 1 4 3 0 1 2 1 0 1 2 1 0 1 2 1 0 1 2 12 0 1 2 13 0 1 2 7 1 1 2 4 0 1 2 1 1 1 2 4 0 1 2 9 1 1 2 4 0 2 2 4 0 1 2 4 1 1 2 1 0 3 1 12 0 1 2 10 1 1 2 1 0 1 1 3 0 1 2 1 1 1 2 1 0 1 2 4 0 1 2 10 1 1 2 1 0 2 1 3 0 1 2 1 1 1 2 1 0 2 1 6 0 1 5 10 1 1 2 4 0 1 2 5 1 1 2 4 0 1 2 3 1 endstream endobj 110 0 obj << /Length 2700 /Filter /FlateDecode >> stream xZK۶ϯЪzF( AM&qs=9YY`$Ę"|ދ RDyfv Ƴ,=Oϸf'jvu3Z0%fj5{oBq8f.W`qL S2cYg4ֽ vJ~5xVLL3c rXbR~?W"z%b5ycX,i.i3wl}GrsIGa)afT~%(p8˒O2$ 'O v\X~| e&Y|#g|V<r1{ |:㨜-bHù"fSuŊXqՆi#amʤX[vjZ݀ /HuOPAqjjeL-~ G[h\nz];8=5aFz+tšuWM@!ۊ+d)p@_n M972ut-2s p){=^<0_<^]]#(1|coWKWa5%4[8۪(m>&4 [ !]e%w$L}B7My uM_7S {K V԰#1*NbG%,Zs/Jd FGXx ON]f ÞѺ uzpTa;l „%0Z{b$: tQrpȊ}h(p[Z5nd{SV^]"LOm@L/45StOLt fmБ_w+;JjuRjEQ,ih%h2(vDcna>q>P;)ֹ-8,z  ;MĢJ}rfO^gUe׮ѱI ӂ?>>Z3sB0ږ Hvb$f2ۥ3'`'գc}fnTOS,N%GxFO1İvOM(c 'Q,iF3TA\ V%DVP𐧹ұm . =q ptd% zѕak03ى C +7]NӋ40L>`a{-Aۆc ZΝtn|lOD:fY<.0Po=tAJt)m(=9uU?Vt /U+"eH9xĖ. \BHBl q`Pƛځ/w$<]Яl,_?쳬( $P!D&#愀JNp )[) y,DmRŽ>;!.-<,}VZiƒ${5QMCZ5]Cq}OKXCOӁ#:'uWA=Wf>r[1.z;<B t8#Aroή5ؒr UKvLӲ/xs,Cpr{x>wp "/f/.~+&hMv xd1cZ/@90P1g~,;r FDEk7UGx"zV5qu:ɨHM{_ UO"l:?l_[ _]\J IKw{%F-_7tFo?@I2oBKׂJ#4?3W@%CuxHHH: CeCp3*܊)E@ endstream endobj 125 0 obj << /Length 2134 /Filter /FlateDecode >> stream xڝXMPTe$AەJULĩH3#Ӎn3E@4^ps 7xn}}*7mb0&J$&Ote_|) c0g?㤥e+B%IiJmR* NIaҋ2D14pU42֌Ij;8ll𰍢hϡE[8s8~ߢ u֗M/ f״JOVŮi0w+F /ηө14x:lb2{լy͈8&~|h 7tvNi1ɷ8pbpzAnkE!J9H128#l;4CSXhR"N+XVZxBL`? \ڵ ,ܚn c 4lwv,.BjQ`#0p @Y@L3Xo^nT'FYa~Zp”}b:tnr~ňw$gǓZdѝ/o(a/&;![:S2oHExUlU_*YH/E?Bŭa^z!qaY7XQ{@8G^Nl.?a'*EJ8nGʣ(3\)x#rxu.0J[>X]bW wMdɇw-a- ߘ]<C~M3N\f}[dzN@y ~C)sx8eH_^DCnIy/hhQVBG_A@UZMk߲2ܾ5 I3.6~Hi ~y˻PEZ۰e{Ӻ=sRʶ=|Ùؙ8jhYyTu K_B@7ahwgb=SUW-75Y=y=JYɫFME\}ɚj8֔x>WxTde  50 md?7`;cӡx q&_ AmP5 fΣ-` 1t/ZPkկ: EjiT/ߵMnAT;N *^pO&2uA}K @ >-Zw~ endstream endobj 135 0 obj << /Length 1216 /Filter /FlateDecode >> stream xڥWYD~_a vۇݶ# qi!'I{*Wۉ'6]GW}u{+{\p~9xN^R-7LӉdq{ܻY5 Rb7YviMN䶞ο{. r/ lD2v;6%H>{jE:J4z8 ˆH״4̖6}egghq}u2Y$S:f Ywji-G0l@ƒ8,UDTuC`@\Vn1\ZwV#kss2pp,)IjoC>}a)?|qDP,eU>[kHR&uسU+J3 GPH+JOZ@EG.CLC0":wfO?m"ϥHc...>z8w#XfMa;۱W,EuSfcQ}6Og[<ۥ-#^2.(!A):%D Ĺ)~I>HZQG p(t3#W@tTKHJ5mZCha*a*?VP扄RIDU, kttߘea:VQ2.hd`VP8hY'P,W." 6Nd֠Cv۶nDKld%&Qkˠڧutd\DŶ({ܵ$=4r* Y£1 Xğ Dޝ ¿fM[T+eȱm>!4w>lbc'yfM6-/|@A%k}\~SjXLS&עq_g% J(-{cr 2 hH>%.d 3ܙ#ux}N \W3-bȪXen9~}O^״zW"J %AP˖ zg}(%)J5U2`=4ϘNF%05n(@396WA3u6zĺ6Y~8Ex(\?wnĭ]]?{A.\]>S9lqFgsFS#EHJh8wIF_/j endstream endobj 139 0 obj << /Length 1718 /Filter /FlateDecode >> stream xXY6~ϯ0 CԱhZ@(Z4 Eŵؒ#;!e&yK9g|[Տϸ~w  SI*W7w+9Wi.Ydj&zUE6n~+z~Ei ]=7^32O_ 9$8)oAL<PrvxtOaoHM*06mיpx"bHLQO,20<׫X ocm*#ANbeTvv>v#>vXov.}6lkѦiv ͇BBd逑ɓm)TpXp"KDFjO$w@ _muC3Һbv{x&S1t; o<iDr"ho{OBѱuchkG2|*#zzk >N,HTqo3'gKU<@ٔi$٭uˆV-MG ȇ" RJGC 0 q2[:dx >ݧ7c,R&e=uu3B"S&O= ʖHbTvh(\lӌe2Y(ҋw!0ـ)C1ѕ/2qE-1ɒ$ae 6Cy<̵dSZ2!DWjHx́_-{ۯ^0 sKNGxqsk[ t*l Pn(%0puqLoBr/"¬R΁7JIhOf: BV/$n >aQvaڛIP1JX= 0x|EAyN*B׊_+$iBO.?23wYْ^$Q0 ɉuU>WIǭKġ ?$<u endstream endobj 144 0 obj << /Length 1610 /Filter /FlateDecode >> stream xڝXY6~ϯ0܇HuiM=@$ZkJ$'p(['@s8|/O|eRF2-ogRjz%a<[f m8RX1~eZf*e<]5BƭV:ԙHr33(IGR4Td]$n2⑓Nvq 鐩(]^)Mq$S2ݐ_')cs'SŞLLSa$G@Rk+}E^H+Zohg՞xVyu۴t3E;3xwәrN|%ld]g@5Asr_&ޞ6Ic_km^8f6׎ܣfG\T#^ӾUS ܐ*y4T|>@@/ـ$C 'WUGvɴMd孡ּߕq8xnжKPeM6cV ePŃG%2Χ\J ݱMMV&kc!1o՞Q] 5))*`R$d8Զ]]%WRAOóL }Ol#\Cl.Vk&Uqd% aer >3YW\]ESn ME 9D0@0W|ydhAٶf>S0:MX)Ի'J|5\([ ZI򩁪Hx9DOm~peCGKptj[6!bE@hiO;澴l=4vM9r]uu|-53/Ga5?7ЂC\ laϘ pu47)ի`!TʀsLxmROz(x U@ƒt-ksAm `)KTrDKm8i2 GՀB@%:p&[`if>Fd(;@@t'con,x5G?UDc+[NLG+ymF"A|d< &E߯-z<+\r"W`%y fb*o]ڳ0Zi ѹ3yɔN,L`лav0r`$2!9dzQĔ)o\J$65RTvFh*kfnZ 6dŻ֦Y]V%dND{"B,Edt/;5-f@ Q@,0 aնӗ,si7G%^ Euk렩JqԴ)qq#x0i!=paAt40;>Y^qμ?F}g^x &fb~+u1ߝi.}r9;I=DH[14^&9@ 9$p1d3NNf'$50.YhFI&7KM޿s9!Oxz8 AW J񥂮'/q N{Щ嬫'U#qG/it6 IJ$Ē$q>y endstream endobj 149 0 obj << /Length 1645 /Filter /FlateDecode >> stream xڭXo6a ,Y+a];thxأ EbcYrߑGV< H }{}GNN't/fbIy:Y|p*fjN2M}R4ۺ/~WZ甚9q>+jfs<fsr0/NocC.AN;}}~q/ 0IL Nr&Xr9K&e8$@|1聾,ϒ&G7D^yȤڳ+fRK[\9/qMRT{8qYۋUUT JD,)66l&¯:*:&AĽCO1׃_w5[t:]`w8W2llb S;ag_ƽt t.ttCvOLw߯ xy[A]qmkq0dܕf!9b%QRЯnk4#)TIHlK()W{ݪt,R WԔS!i$Ҕ(1i9BOp13ɪ9q @=u xҢxi7 [‡QZ&G6'Ϧ1${;i_jՒXk`o )K&֣(Y9ο\0ݞ>JNuoheby_̇&2O!U&hSV|69DT몫>[u7tk)AcCk`P>krX^UIoGt4mH-v~st>iVS|N?f|8ZFBxoE7xiVux,m,9~Tu ROlmvo轞p7Y&daBXtHI^k2rZ|񁆦OXb--NTӵ٥/5 ,9ʻ& rr&G[7bIwyuA_Bșz72]| ū| os zo禞o*\(=%]:΀Uuy.z%U=utow._;_UxXO-V,m^: =EbE׆gZS@z#I4PFQ|j0? AʏٜBCQPa2ݯƲ~FQ9 x FArwN"CkL'iӑCc endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 870 /Length 2938 /Filter /FlateDecode >> stream xk۸b.Az !IG^ۻql~}gd[M4(+p8gHќ0ĐBG83K"'\4i/5s@µD{ 8@%!\*hY8xnDDŸP(%SDhxԆh Vh @8h]3ux#Erb`0JXF ǠP1V8k [34 x: 7Р1 ,(`-Dq숃9,H.'P$Bi$Ȑb V\:"'t͕B0AQzep*`p̕9t588B Wi(]b"C O[@A*9 9BGLb %0:3;Yq#p5PT9 wSD(쨀5}ae LsXd$mA~RSH;('Ln5րxAoϋw 2|E/\(|c/K5^~u]q5gOx(>0ŰUOnC/롍tU?Fv9^&mvn7M{nlC}Nw-ڏ"W5s\d nuOG&$Y$eM޺c^_=*$뵑mW5|yfFx$!]quui`@B(= Ҫ.ɸm9=CDonZ ؗU4 zHsщk3TIl;saQw(N#NGc{U4َr',n]{l>d(Ъ,D/#mO5 njXأJaV#ff7ɋ)P(̾{iH!z:J>֏ nBtsM)Eqg+`3I>WvW\2'ogeï3emt=udH2xֆ:qD'I8.}M@G;; >}:Y4:^^]}@h`kZ7???g~uGWKRW5{"p\zMw^f}~zWGS{4ܿ#JڵeTϨ0kY;i\1pi'WLTG&/IIM^?| ;$PvML' d팂uϯGN_&½҇(\ܗgHEҽ0׳)$4f֣ܲ'W|J$o{)hscY<ŝ zG-Tw2[3WR1"?O '=<µ/Im'rQWǾ^Gr"&"u/Qxlv':c# W<:Jo͸Wќac.yKo&{<`av|nn\G~Qف_դVz> ?eeŁK5K,ؗ\ :ŗ/nCMbN KyCg/wS2et9 _nOBor<]U:GNf=.uP,-Bl~,z']W6bSM6fSluŦ`3-oK-TRoK-ܠ8_;9_WσOd> _U93^f@4]p?SǥCOt(KH!N@0(Z쐚 t;5S{PǧC9NEҡ*M>QfnRzaN@j Þ)-~IKq:$B5dHG!Ý dKԘl;*!i*m&E!'yoG-!T׺Qa>J!Q-BLBNQ%xrSD#eg'p\!#'h!BD ^#nUhNob/:_LQ Te' [Q,G yhJG?vB\ BPm8} AEk<\6\m+FAEo+xmC]y{7xp| _)ҕW~1BycNq\x;Z(Mkx> XKYJ,d4σ9<` tPBwc ; EL<}TgATvP䓵N>BdL v(x&M2" XBd%-{FzO %a,(?:X ~g<}nJP⩂P2_mؚVPaxj||F9ms?CVOVlV1eu2f7m endstream endobj 154 0 obj << /Length 1966 /Filter /FlateDecode >> stream xڭێ|8@eVx-I6Myh t8YZ^%޿\HҪIN NJN}M^HUzد6*Ul[}Vȭ0m(뭌bDlR#Xkn1u;>n&!nbYL_0,L„{=q@{ *hv_0o噷{|_zv|$ ,QpnVw;ސT x, PI6 }'׌I5&-CGEA= =^Joj1a"k d0ͣ=6u!DeEr$.0nKWOx Y4~w.f2~z43kog3L\"zUq{%^ˊ 7~nh`g`*346w\^J#yD˱_gAũ&E.6 uFh~A'4Mëyxwh),yexs=w\7 mhH\@ӂg>ʉ-,MI׷6ID AS9 3AAI!O¾;Myטc~O1nڕyAO&lYEsyIe T*t{2`(PXrJ'y>@# nS0KnUm'gF6o&zC!Ncx$Eɶ9CFX>3FgX!0OX|ՠTFA^vIHaAѻWp! c9(Dpůt7Wũ:?aYer^A ]̹l CKIZ/tm*n[UN[瘆Ԛ(CߌM_"yl!M W LD[SҒp~fǁv7s, ;ܥ3T}]}@v[D/Gh#?L?";w[|{ߊH? F}'(-"}'&'8p% endstream endobj 159 0 obj << /Length 1170 /Filter /FlateDecode >> stream xڥVߏ6 ~"U[۰+:`{Y=\(W[ lKcܽ4EQǏa>DC!W+R6UELte2[mvu$ӵ>_9i;8 I2QjPhv$}Ҫ+?sU̞UmO5ԩ)+6ԸKF;JUj># b9E9⁼H YSSUnMvy ˆU4~*{;W6nZ۟uek)|bI1ؾ 11Y2)an ߇ |-9JY+G:"M?EBvMGPȂɬ# /$gEzHƯB`gU_IN.+U愉}&ˣdj;CX65[]*on 4jocw!! ekȀ܀DrBAH)"s< ;3ʦ/B+H]&:W;@2vې֨ӭc .xVٌV ˢ6|1(;*`ȤFՕgtv M4WFce17k`Weί^x'U'O`ncXf2I _blTĒR==S-׶:j } GΛkvx%WҸNJ~1Ps5*J?_$ W3;tF91<(쁏[EYŷwOo8M=1ZdH1t:j %Qʜv?LpU1.4!`dF*wKըC8rN v5t "Ϸ8_C_w!5|OtG6V?>H0RL+u_;fl-Ι9\\3E:H̝HZf,;UTT%Y:@ 7CT٘f$G/2 Ƈ[pW/QLiKef9}`0{Y%i AjPkR1X$eV[+.$U|i2v樿l~\P9L%,}M-mn4h endstream endobj 162 0 obj << /Length 193 /Filter /FlateDecode >> stream xm=@!$ S $&ZY+hfx=%-l,f&LC9QQф)LLs IK^nGՌ9owT p< AZ-@:hM,љTY(P zG߁ؐIavU.R8Uk Z B endstream endobj 163 0 obj << /Length 172 /Filter /FlateDecode >> stream x}1 @bم #BBRPQH!(9eٵ(E!/I )txAM )e8E!Q,LF.vQīI m%;L>?9:^j7N=j AvG ) E endstream endobj 164 0 obj << /Length 266 /Filter /FlateDecode >> stream xUAJ0?dQ^`0v:B[La.]WRU'GQ2xɢt|MUG^dy*W',WOxقt,ErHh,Z}> stream xUϱjP? 9/Pc0$Bj;u(ڎV2HQ#dt`]8x)?DxgDGNx/4/)|8Yb o7/ K7Sd蓺@7=bTEVӊUш?I4M;@AmQSuj#S}7~9`^B 詤tU endstream endobj 166 0 obj << /Length 178 /Filter /FlateDecode >> stream x]1 @ )tMBą-,J-+GQrBt |(1%2EϨR.#ʒ;baPI(\4 ^nrJ1ʒ61E[4%o!Au4x@u/YqDwk;ppjhWO: m 837ġB endstream endobj 170 0 obj << /Length 119 /Filter /FlateDecode >> stream x313T0P02Q02W06U05RH1*24PA#STr.'~PKW4K)YKE!P EoB@ a'W $o&| endstream endobj 174 0 obj << /Length 236 /Filter /FlateDecode >> stream xڝ; @'L#d.1H+PNG)SH7ANy7qLz) c$t&9m8Qm)Ѩ\GvPM3QiV{5X!+{<[o]+rXq[XcװɯxP"$Y-m_~33> stream xڝ= 1G,4+TVbvz4,-y $|=;⬴u2eȱa?m> stream x3337T0P02 )\\@X&9ɓK?(&=}JJS ]ry(7?P7pzrrN|$ endstream endobj 177 0 obj << /Length 118 /Filter /FlateDecode >> stream x3337T0P0Q02Q05W05PH1*25 (Ads<L=\ %E\N \. @b<](&@r` h"\=+Wm endstream endobj 178 0 obj << /Length 341 /Filter /FlateDecode >> stream xڕѱN0`G,y#/iUBFKHd@1#}2xT `/i+Iv|s<;lvf`n6GnU6slPU՞秗{U-/N\U+{B7]Y!]RHޓcb`5__&>\p2yF^;PW$n7#f,dK(4wGHL#ݛ8N{9G8&q}D |pU'hhO?M/+CYFhD&z(xJ"P S>&FfU_ endstream endobj 179 0 obj << /Length 221 /Filter /FlateDecode >> stream xڵ10GL|'$ &:9'ut G(,ijbtr-MIO| t Q?ir8cRZUTيn UQjN;}9% #7߸~'ڐ4o`l!/lf,T0oީ=)?] K<%]g+ґ4&Ym6w\d2] endstream endobj 180 0 obj << /Length 252 /Filter /FlateDecode >> stream xڍбj0 |/ȢM2!NJcvV-oW#x`|O tLe:tzRZAVAwaoy#oiٿ ۽|~> stream xڝ1N1E'rai=]e Z)-H"J()@Pm#tvqRDKoW7T4%5mOo EF߿;#5״=kx_V8Na k]s> stream xڵ1N@A."MGع0 $("*Hs\)7q"w7"IEhwg: ɥB.w.(R]7 4장G] _sv[)Me^ ]IVo]2FU]VuTu `L;Yh@ݓ+'%pT#=m=t0ˎ@!Lu)_AZcA>e]Fw,-$EG⻆Vg endstream endobj 183 0 obj << /Length 251 /Filter /FlateDecode >> stream xڍJ@EgIf?!2|),J--h'$O'Luf66.!;{w2ˮJ:mךtZmw>\>Jqye.;zx-5'yF7cs FƝuƿhwb99.,d?塞\/f)kkko~;k endstream endobj 184 0 obj << /Length 177 /Filter /FlateDecode >> stream xн 0+['0D3j3:9::(:GQ|%A>$pblJ*H˙Nh:xAm$/B3VՖA**~BUTi'26 0witͺT+>4%|ly ? ` endstream endobj 185 0 obj << /Length 323 /Filter /FlateDecode >> stream xڍJ@ƿbaLR|z5/jOԞAAMQ؂-+^'iHv!c"NVҔCA}k < endstream endobj 186 0 obj << /Length 150 /Filter /FlateDecode >> stream x3337T0P04F & )\\& A,ɥ`bȥU()*Mw pV(Dry(000@"7`%!P]AUABC\b?IO 2 r l endstream endobj 187 0 obj << /Length 133 /Filter /FlateDecode >> stream x3337T0PbSscCB.S I$r9yr+r{E=}JJS ]ry(P$DL20ȏ4%zDLB!j\=s endstream endobj 188 0 obj << /Length 198 /Filter /FlateDecode >> stream x1 @ )ir D0 QVb։7 XxaLwcP,r$b_@b>r&۰=p\$b9s)l.Χ˞eDݘ gAd @$ endstream endobj 189 0 obj << /Length 185 /Filter /FlateDecode >> stream xн0#$XPn$Ltr0N_G#02Ϋ88^|vi8ED)+XХq`jPHǨVREet=Ψ͂"T yqs !șKA‚TBCG lG >Mx̵l>\;K[|' endstream endobj 190 0 obj << /Length 235 /Filter /FlateDecode >> stream xڝPN0(m '"+-D $(PRN>-OHyEab$cvfrJ#{heJ^[bcsGzZf?D<& IvXoTbrr/9T8W:fcU KPBq/n?18V|=)1mKVhjcR\8s4%we9FJ&T㛁XZ endstream endobj 191 0 obj << /Length 259 /Filter /FlateDecode >> stream xѽN@ pW"y#^.)j#JȀ GG#dP}0p;%cVe]]E+\׊?;O`{~p*T[n6HF\U#` }R>e@3|(Het%ضvS Oy2C{pW=hnG*"bI $H0AdLO2DZ9I[2EmÏ^ endstream endobj 192 0 obj << /Length 188 /Filter /FlateDecode >> stream xб 0'0ZN⤎ɣQ3HK BA pQJ& 2> stream xU1N0EgEirH.ҲH@Q%$ $&\G\2qi'cgr.Gtt'+ڔn.a{\^h$t)w؂2`Ĺ%"LH6Jm@ FhUj ؈Eeh~rjd!Cf#2V4eOVj,4ڣf#ͽ8cD)'y̗F endstream endobj 194 0 obj << /Length 175 /Filter /FlateDecode >> stream x3337T0P0V5T05R03SH1*2 (Cds<L,=\ %E\N \. @b<]*@`&i~ԃ?q`ԵJ'DB $AD| ` d'W ʼn endstream endobj 195 0 obj << /Length 258 /Filter /FlateDecode >> stream xmN0 u䥏<m*D$02 Vzҽ@cw܁$_߱\g9V{ƿ6vVSw^\=v-\wc'y~;Hd$8ix I["S1Gz ( 4.l1atQQ,+rѝ9(kEvM()Y*tV˪.XMPՈKT*?,E~C$)%oz~?ᔳ endstream endobj 196 0 obj << /Length 295 /Filter /FlateDecode >> stream x}бN02D%P8d H0u@L5 *1f#Cswv %"'OyruNUIW |rFWOPT9C}I먫+zq} KuKGaT޹%l<5hH`XCYŏxm:@f2fO=)`ƿ1gLeMLY ?'L\#x=GbҀ k8c1x$|pdtDe/aአS endstream endobj 197 0 obj << /Length 286 /Filter /FlateDecode >> stream x]ұN0# $LP ?&2`A3<#02]1eBi=UPM.jO5OVOkd~ޱ:=Pՙ% vg(71Oc^#sey<0AsγduJ  ٦ܤ"' $Z8 Vl3cN6[`I@` VLE+w.>A3G)[`M7=~ЇU' Gc{o_>/( endstream endobj 201 0 obj << /Length 133 /Filter /FlateDecode >> stream x313T0P04V01T01S05TH1*26aRɹ\N\ F\@q.}O_T.}gC.}hCX.O? |7Po3  \=J' endstream endobj 202 0 obj << /Length 199 /Filter /FlateDecode >> stream xڥ=@PL ȟ b&ZY+hxJ d)-bߛy63f%gtx0e5$ jOaj:*yAUlQtєg&̛}Nr 5r^ a2ʮ`i`r_zH&=| z)3WwFHH endstream endobj 203 0 obj << /Length 203 /Filter /FlateDecode >> stream xu1@EPLL 1D+ c&jQ8%gdB-^6gߑ;dO\q~ƨ4 Py*^r; SrPEqbtLR~3&0 > stream xU 0ES:ޢI N&O'8:knh@}7D%YgXnE68])$$ƒ~ܟv1ɂ1GG xos*!~Zo(k B" Pq>.۶{xcA+M;= endstream endobj 205 0 obj << /Length 187 /Filter /FlateDecode >> stream xU @ O Yxw8jotr'utPQ5I-$f2c-Z)+GZv*C@Hx=Π9sT/Ԩ"kF㇠ZFQ"7!\LŮ{kw; #e%(𮈻i^/aTtY!)y@,=l M>k endstream endobj 206 0 obj << /Length 167 /Filter /FlateDecode >> stream x313T0P04S5W05P0PH1*26(Bs<=\ %E\N \. ц \. 30߀JNa!?#I0#;xI#> stream xu1A50]c&k%P)DRAhQA;C_ V:F:i]yYm)5КԸI T:"$a"X B$֞?!#rljtjCsehx. MO {}RmU@#C3zT endstream endobj 208 0 obj << /Length 107 /Filter /FlateDecode >> stream x313T0P0QеP0P5RH1*26 (A$s<≠=}JJS ]  b<]P$ 0,) endstream endobj 209 0 obj << /Length 154 /Filter /FlateDecode >> stream x313T0P04f F )\\@ IrW0 s{*r;8+r(D*ry(01030o`7"b?2E`V`0#H'W ^F endstream endobj 210 0 obj << /Length 210 /Filter /FlateDecode >> stream xm˿JAOSLs/ <{ F,JSP /6G> 曙ҟV녞kYjUrgq+q)L}.n|w>?J3QV{XuG>vv}1=@nȘ^@2"u)'n6?"2ģrL~Q endstream endobj 211 0 obj << /Length 151 /Filter /FlateDecode >> stream x313T0P0W0S01U01QH1*26([%s<͹=\ %E\N \. ц \. | @ v:QAA=N ?@J@#`p`\z> stream x=1 @ER~- g`#8RK EJ4RZ(ޑ'̨i> stream x313T0P04F )\\@$lIr p{IO_T.}g E!'E@!ncr e endstream endobj 214 0 obj << /Length 179 /Filter /FlateDecode >> stream x313T0P0Q5W0P0PH1*21 (Bds<L=\ %E\N \. ц \. @xD2?@,&=`C" ?ƏadjƎa݄lMI$b6LrzrrШA endstream endobj 215 0 obj << /Length 124 /Filter /FlateDecode >> stream x313T0P04 f )\\@ IrW04 s{*r;8+r(D*ry(0|`??0 ? v'W a* endstream endobj 216 0 obj << /Length 118 /Filter /FlateDecode >> stream x313T0P0S04S01S06QH1*2 (Z@ds<-=\ %E\N \. ц \. c$! b\\\ϊ> endstream endobj 217 0 obj << /Length 102 /Filter /FlateDecode >> stream x313T0P0"3#CCB.#)T&9ɓK?\ȒKCKW4K)YKE!P E >'W $ endstream endobj 218 0 obj << /Length 137 /Filter /FlateDecode >> stream x313T0P04S02W01V05RH1*22(Bs≮=\ %E\N \. ц \. QqC=C=2p\   \\\8 endstream endobj 219 0 obj << /Length 205 /Filter /FlateDecode >> stream xmj@_<s>QiZ &z(BNM9$7GG$f+`f`'TE‡~(=iDEI1E2HQ]%0 T Qm} WG?pj26N`Ԟ}}gvjPhCLQmQ +I.I7y-q endstream endobj 220 0 obj << /Length 273 /Filter /FlateDecode >> stream xuN0ty @!R)`b@L 5X dcģ҉&~uD9մWӤn |0rsK*kN%Ƭ9;fT`6kl:AP<ʋفa2~z`j0:hoTн Y,lR7"fSҮ_‹ᰮ@c91XtX u(cAr6y.!nCI@qqHf `W4x?l endstream endobj 221 0 obj << /Length 263 /Filter /FlateDecode >> stream xu1J@7L17l hvfm +BBBNVbKX"$IX 7c<>HV<|ɒog@%N~oniQtS)1(Ռהm` ]\ jys 3[ =5=9L@jT TZ) iv@J/cqCS86vKdSΎJ4{wS2&-e$ Ԅ endstream endobj 222 0 obj << /Length 282 /Filter /FlateDecode >> stream xeнJ@L304? 6XW0bUWV[ +,Lv<7) #I6;O9挏N8O>O:Ks>v g.__t4:DG ^&rD*Ovt%JtJRE8)m _(j#χA$`Fl r5YɀM%o x}nR0k@( V:P/ ~#+ 祾` endstream endobj 223 0 obj << /Length 188 /Filter /FlateDecode >> stream xU=@`6$p.?`# b&ZY+h+L9 Gذ nKfQ!!^CUdx[a> stream xmбn@ 1DG@ CT*CdPeJ;vhծGQxFkDd>;zWMrMMف5eJYƿ?mvϬ ΏToHN [`CZ,{ê3VZw LRD%ڻ{F:lZY> stream xڥ=N@Xi=B,  * D)S&\7GH6.DIi53oXk]꥞Z\ޤY\jw^%{"e;xIVV;RoN>`a}x3 HVmHb&oNhh:+Tp=q::Ϥ>F_/C21eya:#f`x!7<=c endstream endobj 226 0 obj << /Length 208 /Filter /FlateDecode >> stream xuн0k#xO `D`qRG(}FBЄĤ~pE.-K =zh.wStlytGN_NgL\kZZo-T c ښ[ۺ8Rf_yOwy_6|pdmA&:QV&ҘP$> stream x]=N04M8!UeHbD9%Gp²!4_fjOKO^swۆ^%k#n{27ocGf}w ?6\?Ѹa@=*ŀ2* : (}!WjtYW=-0|3?*| zclb`Q$9R 2S }Q:Hq/3@#7p@ endstream endobj 228 0 obj << /Length 156 /Filter /FlateDecode >> stream x313T0P0b3SCCB.c I$r9yr+[p{E=}JJS|hCX.O0c? &p`Q"p@#`p`2QpOar IVR endstream endobj 229 0 obj << /Length 163 /Filter /FlateDecode >> stream x313T0P0bcSCCB.c HrW0r{*r;8+. ц \. 001 `LAȃ=`Aԃ:\?DԡQ?Q \\\[ endstream endobj 230 0 obj << /Length 242 /Filter /FlateDecode >> stream xmбN0?`閼A' X*E"LSad`y^o+dc$sT@|89:]NT8V4)[bFw)/=e3ynr5z z^AH ^_kO mb2{ o)޼IPX5`j5҆uiSy 9i^Z&WW9+ow }:难{{ endstream endobj 231 0 obj << /Length 221 /Filter /FlateDecode >> stream xmAJ@tx9B FSjtB\U.jir(sn }|2)$9?J\ze\)7oϔ-o/Yr>RbGx+$qP-T 8a Hڔ@\fgm{`%NGPik,F=pk0jluo-9m骢;[| endstream endobj 232 0 obj << /Length 200 /Filter /FlateDecode >> stream xu1@![L 肰!V$&ZY+h m(ذ.1мL4'bN%4 )$ft QbÀD4l ;+#/t=ȳ͂B9C X> stream x}ν 0+['SV8sh}>B.E$$q4MS;Q)+!׾28^0+Q.zŚl s ,5yofJNѭ>THA-I?6*<+1vL{Ԣyˡj endstream endobj 234 0 obj << /Length 244 /Filter /FlateDecode >> stream xm1N048IUeHZ()XA 8WDAr)5cHœ5\+.U͵CT2,.[ҷ\/eL#93\SaXw>:@~^M:_6;~qLǠVrﻘJX&{ب#Izc&4~g'.zw'ʗ EJsY#袥} endstream endobj 235 0 obj << /Length 245 /Filter /FlateDecode >> stream xm1JPYR |s}!` A+ RK Eʗ^a2Œ񟉋6̼yT尒x"p,\@_فs/*g. )&LOPvY`n ,{OěMx[l)zi&$vX?zΏE7 }t endstream endobj 236 0 obj << /Length 163 /Filter /FlateDecode >> stream x313T0PaS 2TH1*21PA $ɥ`bU()*Mw pV]  b<]HG#13acFT0ca``?p`L> stream xU̱ @ B>y;mB`A'qRGE7ih}>BAyMI!xLH4PЗt0F#F 5Q$ rJ ELErILY [A37yxZJҖ^ yY\-n-!vjQ8)|%\0ok endstream endobj 238 0 obj << /Length 221 /Filter /FlateDecode >> stream xmϽ@4yИ3)` 8BQX1> stream xmϽj@ aySQ W-8UWT+Sq׺>yB[̬ ؏aT[ʨW>P13gJugbz0_^sްmλK= lhBNb&Yb‚MzvV jDmWNW_}5jio/*e>rƋsOY"W΀g=@r endstream endobj 240 0 obj << /Length 202 /Filter /FlateDecode >> stream x}б P/'HE2!!(hJG"aRq? noƓ>gF;Xdg·S=N[qrt驻8REQdHh^3dxa;| 8uW;7&(#-zH_Q+2)e #ʈ)_,VW"Xp endstream endobj 241 0 obj << /Length 197 /Filter /FlateDecode >> stream xU; @? ` A+ RK E[7GQr)h1/t)ZEyɗϴOC-*2gd6:%Smx],vKȬqzjHHHC,10\qEqRc,S4EB訵H<,l)o e@)]X!uE{/^q endstream endobj 242 0 obj << /Length 212 /Filter /FlateDecode >> stream xuϱJ@_RG> stream xڕ1 P q(dGx9OA ZN⤎m֣xҘ!$!'3N*Φ|INY>-KNɗ[~>^W݊SSNNT D'Ҡi!4y;쑷Gwp{cjCe s]ؗʞZ."US9©-KI endstream endobj 244 0 obj << /Length 218 /Filter /FlateDecode >> stream xeαJA b > ]vj<-,J--mo||ybCBdy-j /;~2xxD-+j.KtoOԬY:ni0s #VH|ěFo;s+lq΅Ƕd,6ɺY'=alp +%D7p endstream endobj 245 0 obj << /Length 196 /Filter /FlateDecode >> stream xm= @'X#MXXSZYZZ(m#Xo[fa5B&x#/~,+E³N|n-f-nKn!R7 !Hꇨ+U4jdcޑM-孍@l_ "j~' f&74.WHe4A o \s` endstream endobj 246 0 obj << /Length 181 /Filter /FlateDecode >> stream xuα 0+ zO`RL'V08iGE7}4бC1:n83d3dftJFq> stream xmαN02Xŏ{H.X*E"L0"5)oG1o`ŃsaA t7;/%KGvA)N v=4GOYScs W,6+"< .L)'rf;GpaF]1P.;a?2yWL ǹG9^jo.G82TJ="b> stream x}1 @49IH,-,J--mMoL2LvY~ Gc 0G8 q bɁD9쎐y Y|=,9 ܂IѱË_ꪽ^cf8y/>_[;bPsfm]vҨVi.oVڷ[eڏ2t6 endstream endobj 249 0 obj << /Length 156 /Filter /FlateDecode >> stream x313T0P0bcKS#CB.cC I$r9yr+r{E=}JJS. @-\. =2>gg`zp=a&f?qA|.WO@.J endstream endobj 250 0 obj << /Length 205 /Filter /FlateDecode >> stream xڍб0# $ hA%1!ALd08FWxX`|]ۑ5]2hH}sBK&rjиjO(6d9(\G.zQ(ښd0 Ԅ9F"Z ,EIIQx %U4d]ԆG mQMSe[p )yX$>A&<5NX endstream endobj 251 0 obj << /Length 230 /Filter /FlateDecode >> stream x}ͱJ19X&ywl 'pVbvb7[E(6W77V80/̤mfRɾ@f|mcqw<︼Բ\vgt|y,/䲖ꊻPLdK?t4g1:Vu&*ޠw#¦%{"oOp($BJ(D|p0hs^>۹3k¸ cԤRP5y>ZsY endstream endobj 252 0 obj << /Length 154 /Filter /FlateDecode >> stream xuɱ 1 ኃG0O`\op Njh(bl-?崚aUÓ+>$?*_5o3z  H1D>1Cf$t cUIa.<5Ga D"JLKL`` ?:R endstream endobj 253 0 obj << /Length 194 /Filter /FlateDecode >> stream xu @`Ń0yVq :fNSuPY7|;4kuhgd4GO q^ͷ=@X f܂x>] C)C 6h[ }POmwj؊n֬GerۺInOs&y?ͅ_[*o&+jIhiKx endstream endobj 254 0 obj << /Length 180 /Filter /FlateDecode >> stream xm1 @ )xnBVJBBB"^do)BBbFST@F R/r@)Z?K6A}cE- ol}:X}"j&xovV$GC* ~f endstream endobj 255 0 obj << /Length 198 /Filter /FlateDecode >> stream xm1j@Ep!fsZ1d"W.B*'e h{A (&E a-]{^ҙ|Xr8}Rݒ;=K}A~qIג7j$2%32 ]hzdLs_Lä_Yt:wjh^H;FU.o%mZ-/LRz endstream endobj 256 0 obj << /Length 230 /Filter /FlateDecode >> stream xuνN0:D%{:&KmȀbj@y?BFi>@UJO򢸑Lȯ9Y^.wv™/}UI\ |~|]=%g\.7B>@T*ƒvPU> stream xuαJ@ )#d^@7!;N0Xr׺Qro`Y#\q|,Oۜ/Ҷ,7nV2oFOKds9F6۵l6PKF@f*;!ɅY$ rHT 'HqĘ8() p^we  * L1j ~-Sё1qx 0hD^)㫎 Zz endstream endobj 258 0 obj << /Length 179 /Filter /FlateDecode >> stream x}1 @]RVBVb(9BʈqvEy03L8I38Byrj5tكL@N0ހ)PR+IFdޒjIWZE,& *>`۰m$jKaj` U endstream endobj 259 0 obj << /Length 206 /Filter /FlateDecode >> stream xU1j@Eq!fo Rd\ l`W)B$e\vG)U8Mb3KtkZ>iyW]VGmZ[wy|گѧZg7}'8l"M !#T ppP\`~ԅƲꌀEwKr40À0=O%AnRZA endstream endobj 260 0 obj << /Length 176 /Filter /FlateDecode >> stream xuϽ @ nY ֫ 7:9::(>#tPCÑKm8r#:&xAk%5ጙC%k,ƭvd9%hr%HDbfRA#JA;=LVi@ &!`nOYo .n R endstream endobj 261 0 obj << /Length 178 /Filter /FlateDecode >> stream xm̱ 0H-}SV08ͣ7#tP> stream x==@!$x.d@ b&ZY+hq%g+̛@.Wy!5||4gN>0U(N$#;NQ=_;!EFg ꚮ~3 |4ؚ4#\Y]gr1WOL$ǭ#bVO endstream endobj 263 0 obj << /Length 197 /Filter /FlateDecode >> stream x5; ` %79m`A'qRGECGEzcokB>bw!ܗ&QvGlE/rPPMycEQѷ(5ҕ;i?͒5-7-ǫy! ^P+́<$r4+n "ID>8q?U endstream endobj 264 0 obj << /Length 216 /Filter /FlateDecode >> stream xEαn@ PGNO_KH@b!`b@L#nvH0e`'wgFJ)S)gG, 톊!څTVK:V6t՜b%71w%;]ͮ:$δ & nKoW1]ЋputF@uFjM0>ɏ) N6#0˾ j5>[ endstream endobj 265 0 obj << /Length 224 /Filter /FlateDecode >> stream xMα@ )iBy` A++Q);l3j:-(#IorNjNӜNP6hW%OR9Q[Qv$QKRvrM`> stream xm= 1F'Xxf׍ Vº[ZYZZ( vz4GL?13yL`(d8.,mv}zsQ]볝bʶxޱ-cIٖJ%YsU f7[q(hV젨[it'zS[ v.Q*FEQ"x ?>&Twse endstream endobj 267 0 obj << /Length 221 /Filter /FlateDecode >> stream xu1n@Џ(Vf\^PXJQ*;eDv mGt .4#Jنc^"U4aY:m_ȼqy1'ˎ2%'PU2| (2w(ڦE-zD6BF{DIڝ3?mgDj # Arf#rNN,t']c^al оWqi7 endstream endobj 268 0 obj << /Length 170 /Filter /FlateDecode >> stream xe10 PW"y#' MKUJȀC X)GQz U 8eSI< e 15ߗ rKIr5JvDYPT)wK@1c5 0|2 GAw= /t:pZi|m˸иI Pt endstream endobj 269 0 obj << /Length 229 /Filter /FlateDecode >> stream xmбN@CA2 <əXg"WYBh<>%aKK6eg]B}}k{oxⷊ>.6-\WT<*#Syc]nyv@6CG'=D",2dfFz-mə1:;_w1|4t4hn7)xM> stream xUпJ@YR,LGȼnb.r6?` A+ RK E*-GHEq[E}\I)rVɢB+~ziRz>yzu^%k+snv#r69MD^HjO@IGJ3&`MS |08oF xo2("~B9~}B@BTB_Cmc1aH9ԝz xk endstream endobj 271 0 obj << /Length 214 /Filter /FlateDecode >> stream xe1j@[4'JT@!* q"JR n+s.*70‚,̃0ir$CdKyyωf^ˊ$9GlӃlKZhYqb~OC~OxCH7L-VhPjeL hA؀&jΨ\5әcts÷|*f endstream endobj 272 0 obj << /Length 224 /Filter /FlateDecode >> stream xuϱn02X%{D,Q*5C%N@ծu͏GCvaOoQϚGhI 5NXYQ39^pӢ>PB"m+}~|QovOdPoP2Gp=AΘ&n > stream xm1N@ D'JM_C~QH@Q%Z6T({-SD1Q Ѽcgqwm݉>4,mFG K=\ۣԻ3mm; d plFar&@GPي>pOc({zUAL/.ީ8|ks endstream endobj 274 0 obj << /Length 202 /Filter /FlateDecode >> stream x]; @GR2͚Dp A+ RK EBRZ㬺8N(->GCW;]@G5v*\ jwR] endstream endobj 275 0 obj << /Length 251 /Filter /FlateDecode >> stream xUN0/ɋ @Td H01NͣQ=X1bdoݿꯇNVknӟ/b+C~g7A~u}N7;yq'rTL6lq#T%TӤE jU$T;xؙVpya"Q1|r9@af6Mq@R{ ͊Ie,yZ,[Q?_Wu endstream endobj 276 0 obj << /Length 241 /Filter /FlateDecode >> stream xuϱN@K5 E+uM0bcl <Yumչ>*epUy> stream x313T0P04W0#S#CB.)T&9ɓK?\K(̥PRTʥ`ȥm``P73`v(PՓ+ L5* endstream endobj 281 0 obj << /Length 122 /Filter /FlateDecode >> stream x-ɱA($ \vTSHB $:@\#Q_TQUE&MG-nu8M [Yð,ΐV]'v=WN;S3uz3x:cE_ endstream endobj 285 0 obj << /Length 274 /Filter /FlateDecode >> stream xڵӽN0`G"GTy"R)`b@sh~>B ;9#,u}N^Yr_+;l:P6P߹0=~}~AyAnַ6*@<YXzDrYqEfakT3EJ}*ْSJ ;f).߰Q8m(Y(|jU) /+"Wv&˳J$\j銌:D2lc\+> stream xڵ0KLnB: &2`A3<#tth8{@bl~륽Z0ijJ%;yErAV<@nlduVct"G!#xvE@E}lE˳aΔBT -:4!uH _;B١ PHɢ>K5Y.v&Aʲ endstream endobj 287 0 obj << /Length 239 /Filter /FlateDecode >> stream xUαN0 `W*y#/pmH! & w9x>JcƦI,Rtu^;-yÀ3{lu@_l9ҋp$!"•QϕKp!rМ#C6$Sgh$XhюQ42Y֕`{ ц)߮2N3@%SoHqIhݣ2YJ՞1G}4J^Ļ; endstream endobj 288 0 obj << /Length 179 /Filter /FlateDecode >> stream x3135W0P0R5T0T07SH1*26 (Cds<͸=\ %E\N \. ц \. XvTN {Q" F "?n d 0?`{!`(0pzrr endstream endobj 289 0 obj << /Length 254 /Filter /FlateDecode >> stream xڅ=N0y!>NiRif@1AGunJnB1H&gS'-t_ͥ~% O/nffǻhG5~n#f8'8;bA]'ˎͩ*,$Fq u"QKCr\;;:Q3')u3l y ٔB<8Cq!Cqsy(e!ʳUDԝ- endstream endobj 290 0 obj << /Length 220 /Filter /FlateDecode >> stream xm= @ irFƀ?` A+ RK E(B\ y`2dvGǕeЗCg{SēF-r܎l'dlg$q9p?gT;$z: /ר?p1%"1XA2kձV^chk5Oi̸;ݬjD, Ac%a- endstream endobj 294 0 obj << /Length 253 /Filter /FlateDecode >> stream xڵ1n@E4o^LhD@T(U2Q8J@"o QRb53;7\zF}:*NiSpBeN9+ }i2YS`]HH "HH)Q -h @XDh s`n`W\]WcK<[?M'_=? Q^׻wgM̅0'ܘsdM]3蒤6 endstream endobj 295 0 obj << /Length 247 /Filter /FlateDecode >> stream xڵPoLGȼ&.V[m!VjŊGˣ!z׋ 9_v쇦j~++WvA!ɷfV SnvkI=9Rd9=A|0&јA IIДW1#`EGp`F(A~z=k"Ҽϻ7gļc̓2_5s/'7>~e\ȗ\E endstream endobj 296 0 obj << /Length 168 /Filter /FlateDecode >> stream x5A @.4 P3EPѪZ(j(Bh)X =o<X+}x|t&ت i8%a\N2]r;W3$jV;Jv YD/> k >0&(ѱp+f4OiM_4w= endstream endobj 297 0 obj << /Length 167 /Filter /FlateDecode >> stream x3635Q0P04P52V0P04SH1*24 ([s< ͹=\ %E\N \. ц \. ?0a QՃ aHAj1~``~|T'W 9 endstream endobj 298 0 obj << /Length 106 /Filter /FlateDecode >> stream x3635Q0P04F f )\\@$2ɹ\N\@.}0PRTʥ`ȥm`@#\\\hE*a endstream endobj 299 0 obj << /Length 95 /Filter /FlateDecode >> stream x31ֳ0U0P0T02T06W06RH1*2  !2ɹ\N\ Ʀ\@a.}O_T.}g E!P E?< r WGz endstream endobj 300 0 obj << /Length 210 /Filter /FlateDecode >> stream x풱@ 0tx &2`A>=@..,:r_{^4ICƸI¾uaw$=(r:_N1]&p eV+k]nC%0!$ؔ'lQ.1DP밨i􆀕RHO𤲀tԗ?m6 M?~f0T endstream endobj 301 0 obj << /Length 223 /Filter /FlateDecode >> stream xӱn0`#HrOP' [%R3TuZsx&yT Xjw><?LF3k>m&Zb&RJ'/Ut1L|L) uUp)v -?@׌8;n=pOkq11Ecf՘1>KZ*t}w{7:y+}k(R Qtn endstream endobj 302 0 obj << /Length 252 /Filter /FlateDecode >> stream x퓿N0Ư?B.*SR$2 Āf(~B"UIE.,tw#9z{Ү[-c5',i]}o>٭nl`7tĎJf&@D 9 HGޓ:'4E&kqwo5t 3HwhGfC _({0 54L`|Gi0>x3~wۚ: endstream endobj 303 0 obj << /Length 245 /Filter /FlateDecode >> stream xڭN0 ]u䥏?iO=qHt@1#(}( $盳vC n颣߰ӾVWۡY }^R@-583@ڰ (98"\Ppt,^d^F4FdOg7+\K5@N'U}2*` ReʨPŌ>r.dWF$sx5~ԇ endstream endobj 304 0 obj << /Length 123 /Filter /FlateDecode >> stream x340ҳ0Q0PaKK #CB.K1s<,M=\ %E\N \. ц \. AD!o`e b gS7\=b endstream endobj 305 0 obj << /Length 105 /Filter /FlateDecode >> stream x331Q0P0bS #CB.C I$r9yr+r{E=}JJS. @-\. A(9TH:հ endstream endobj 306 0 obj << /Length 346 /Filter /FlateDecode >> stream x}ѱJ@?lv_@p] !p` A+ RK E;!hM7HqfwO`vv23)Vf0WI%X8=Uk3UqaUASSbmn*Sުvm| 82"7@б, }8$tHIR2>JJ =MT;4[6R׳ā~D}~k.:6ʃHϐDJwk81ۇ=Isz6WBJI7l:ahJ7Cަ85,φkVq< /XYd|vRJJ}I endstream endobj 307 0 obj << /Length 233 /Filter /FlateDecode >> stream x퓱 @ S:Y|]I(>BGLZD''|r7Ѧ;M CA> 0Ym՜՘eTфU8A5!hHpɾe PVr{y%رW Kp,+&uaJNEIM4y0犉%ޭ^ AlH4ȗ6eOE8`| endstream endobj 308 0 obj << /Length 459 /Filter /FlateDecode >> stream xڭӱn0q p#/8$)PکCѩءE ,z=GPZNݸ[wUzmnݷZqu~}ӫOC^׫{w@g/z"Ew l셀;ii24> stream xڕJ@'LsL 'BB> stream xݑ=N@FJisX[N"GTPR; 9BJGZ0; Jifw<~EqUQAg9T )fT3j4wTN\IM}MoOhf7s,hSv`ځ_ hv= {H 񞡱B [r%kT3. 0=;  ڿv>;bC _\Af #c,'4/+;hq1h?7p% endstream endobj 311 0 obj << /Length 243 /Filter /FlateDecode >> stream xڵN0/`?BdS` Heꀘh XI-#d`stgۿ~Iy)x 5_XQ&oG\7vWEF<z{O5 Tb!ȣO!2J`@;PP<;Gg3E9c̈*l09t / inm';)),bߘ^Jq݂zlgF endstream endobj 312 0 obj << /Length 253 /Filter /FlateDecode >> stream xҽN0T"GȽu~n! & 7+Q!ʟĄd嗋l4\jU<sMo4HQ {N^Kls/dKɮꑚgʱw_ s=$p8E . (sׅ42*ȱ| ]6&ܴLpڋ_IHGN!X>] 7#f".F?^Q 3ҙ b= endstream endobj 313 0 obj << /Length 244 /Filter /FlateDecode >> stream xڅJ1g"0M!`Dy[ZYZZ(ںy}<•aǙP1|?IO :1H=>cTPc;Ocw!^_[^ʙ;V8?dmgPj\Rq :dĄ* |Vbn;gE d1o( ؁ahDBc!D[o1En %in6N:\Z` æ]H_I<?y뭜 endstream endobj 314 0 obj << /Length 175 /Filter /FlateDecode >> stream xн 0>B L*)j3:9vtPtnG#8f:M|~3z> stream xڥ?J@'X&G\@HBL!he!RK E֛L2ɮ9o[,Ƴw565>UU7v1.tqoYKtq ˣ|QђCDF"RcB|&;J e%wpU3B?O|G(^'f ]THد|X9/O8E.> stream x373P0P0bsC cCB.33 I$r9yr+q{E=}JJS ]  b<]0$0a aÐef0x:`P?H e00?C(v q'W l2 endstream endobj 317 0 obj << /Length 138 /Filter /FlateDecode >> stream x3635Q0Pacc CB.# I$r9yr+Yp{E=}JJS ]  b<]``0f+ɃԂ 0a@\\\٥; endstream endobj 318 0 obj << /Length 205 /Filter /FlateDecode >> stream xѽ @ ,>y;[hN⤎|>7cj+: ]IK7H(6%5x8&grajIqjZgP3:;T 1 5c+ p kQ)cH__#D[ v\o-!_ utòʈe2fx\ endstream endobj 319 0 obj << /Length 243 /Filter /FlateDecode >> stream xѱJ@)nMD BzQ|-#w_Z˷euG|]KkhFrw[r??ܓ[]rKn7-74B,? X -,fXNpMV%\{`r_ |7fZlP \X~r['-pG NZpZY̊4_HWn$ endstream endobj 320 0 obj << /Length 107 /Filter /FlateDecode >> stream x3635Q0Pac cCB.#K I$r9yr+Yr{E=}JJS ]  b<]0a\= endstream endobj 321 0 obj << /Length 232 /Filter /FlateDecode >> stream xҽjA W#>WZL+vrp!ET+ -vXqt;';됱j-->xsiNY-gOّy+#CYEI O$Rx%4DJʤn ׮UH@Y$߸Np⧤D@(Ax^ 9Eۄip xviC endstream endobj 322 0 obj << /Length 184 /Filter /FlateDecode >> stream xѱ@ & &]xHLtr0NUy{ጃ zw6d4JBGqlfiG{1+P)QEz@-ibc|!Pi ౮!`{.TV6ߡA_y48+po endstream endobj 323 0 obj << /Length 231 /Filter /FlateDecode >> stream xڵ0kHnЂ0 &2`A3<#02^KL%!_s{I!.qa@CT9 +@P% 7 v+@x0> stream x͒N@ ]uG_.!MBH 02<Gx۹F:.˓"J:lN錞c|,5<WO(m(KѭEGWbtK=b$(#!@5@oJ 4{aŌfJ`o}4.lO%wm_mte4](z`_TU` endstream endobj 325 0 obj << /Length 266 /Filter /FlateDecode >> stream xѽN02Dŏ{pBNJȀD02蜼7-[+U9.*S%;lD etu32<߱ȥPY7TT漏zϏ+-RjJ!70x bf ŭifP x f BdYq i`ur?3!X>1 }A}asc!C:9OD(fS g d endstream endobj 326 0 obj << /Length 169 /Filter /FlateDecode >> stream x;0 t#' VbTD$02`nQzT dj20XY陞c+4xRps?aq@iA W<ix=   E^6ɱC:_:Wѫ}O_ /h m Ij^ endstream endobj 327 0 obj << /Length 259 /Filter /FlateDecode >> stream x]1N@4;ۊB$\ Q%ڬ\vY)yTk.拊57 UIJ/Kn6O\k*ybx[~|nXp8HDF#々~7'QȔ^;LKZ+45qj@.dtv!"ieh֔j]dV絳Su ?hgcfKxhGZ endstream endobj 328 0 obj << /Length 186 /Filter /FlateDecode >> stream x3534S0P0R5T01Q07SH1*21 (Cds<L =\ %E\N @QhX.OON2bH$;&=A$3?8HAN7PJ`$H `( E` qzrr:p endstream endobj 329 0 obj << /Length 187 /Filter /FlateDecode >> stream x1 @   fl1[ZYZZ(Zkyt {O!(VhpZ0(j. 匴F91J3FNPf4W.dI K#ZX+ސ8 w6 .n N<sUv848n endstream endobj 330 0 obj << /Length 252 /Filter /FlateDecode >> stream xڅбJ@YR#d^@7l 'BB+RgvE8X>Y؟/Η%YJyN^RaaB> stream xڕ1j@7Xx6l6@RXR%)S$$fB.2Ni!7.V?u~f*U+uW9o(fKUn*< ݖIu>?_dRLjG/zV!C؃@p` 'h'đv3k"t{O<8 F evb883MmH Є̎io“z>Ba"0i5s?hb8T0c00c*Cٻ1 i<8^gvJpi\DXו!) endstream endobj 332 0 obj << /Length 270 /Filter /FlateDecode >> stream xڅN@EPL'~ >X<&ZY+h+| K$\gfX){ʪߗu%B-k_Weʡ/ϯ7/nyS壼'7e"0қ0Dr92DI-٨l+s@!٘b4Hfoq!C?I?b`6|tC t} lLD2r1uIU'TuIk*T%5P%5!.>Z/1 endstream endobj 333 0 obj << /Length 310 /Filter /FlateDecode >> stream xڅ1N@б\XG\8M,  * D "To+l"0DQXO]yx:NbYٔOG8'M~ea חG/pl%ގqtg%Qm3 "Vϊ<X1f3j ԄMVl!ey o+ =̃Zy[coFG\{SZƛЦQ?䍉`߈=m;4M?l½};YTjĭjө IPZlklku釾2#}UJ.҆Rymaɽ endstream endobj 334 0 obj << /Length 232 /Filter /FlateDecode >> stream xm1j@*x-"cUZp@R)b.X:#T!vRYH ~Y7zVƷY v_ԿQ[ݓ;N{{W߹ʭ޵۹[J0)\$x " LY$> LQ~ 3 afˈLXF,@' .L h22#戜#䑁rm\-jhp endstream endobj 335 0 obj << /Length 229 /Filter /FlateDecode >> stream x͒1 @EG,is#Uew4c!r9_lD,lD[ΦB$:[RI9z% 7t | t}GI%EP_+M_*|u69X~ohFWjҚnD!> stream x3337W0P04  )\\&f  ,ɥ`bƥU()*Mw pV0wQ6T0tQ```c;0D0I~0Y"I ?&D(I"\=VI endstream endobj 337 0 obj << /Length 301 /Filter /FlateDecode >> stream x}MJ0)YؖG_]x>.]W҅h=Je? گiftߟ ChÞ6 s/\knCs%ux^ߟ\s>k o@B,D'DdZ"-,-B/63"x甙k p7q|$pF暿 dL@AvZHFӬYM5k|,ZdIeb4j`Mg!@Tt`[Bͻ.A8Ew̕bԊW'bt7}t endstream endobj 341 0 obj << /Length 166 /Filter /FlateDecode >> stream x=!@E OvK+IJIXA APD@@G( y?, xx_ay)];rجlBل.M±iq[ H4eD×MgT'L;u Bt3ۿ;< /7k5& endstream endobj 342 0 obj << /Length 167 /Filter /FlateDecode >> stream x-1 PDW,m> stream x3632W0P04F )\\@NrW %E\N \. ц \. v `Փ+  endstream endobj 344 0 obj << /Length 208 /Filter /FlateDecode >> stream xe=AK *#t`Gp@@\C]`X}gx|:2#NKL61YrI?L/R=mFa;@_16owP + uaVpw^~D5\pcZ~?<5>y e` endstream endobj 345 0 obj << /Length 168 /Filter /FlateDecode >> stream x-̽ 0>B LP)P+AAA9>cR~p;Κ9Vhkr+tm f-S0~.Q= *4qI9bH+MjT  3B-). #-%$s|;tI endstream endobj 346 0 obj << /Length 162 /Filter /FlateDecode >> stream x3632W0P0bcC#KCB.#1s<L=\ %E\N \. ц \. a`XA=}C=C=CX0LS|zy'W 7 endstream endobj 347 0 obj << /Length 214 /Filter /FlateDecode >> stream xU=n@4 -w.f 4HqT)A$[X+>=Ɯ!۔f<ݬ͎f9%l3J^U$_pdªy5s:.!_MWHa~”E:Su@I #ABФ?_Fr"@@;^p6kʎ4EN ZH endstream endobj 348 0 obj << /Length 144 /Filter /FlateDecode >> stream x3632W0P0bcCCB.c# I$r9yr+q{E=}JJS|hX.O bv|o`G\=<[ endstream endobj 349 0 obj << /Length 119 /Filter /FlateDecode >> stream x3632W0P0bcC#CB.# I$r9yr+p{E=}JJS ]  b<],"ؑ@6'W w2 endstream endobj 350 0 obj << /Length 144 /Filter /FlateDecode >> stream x3632W0P0V54U02U01RH1*22(Cs< =\ %E\N @QhX.O ?PP01 ba? ?`'W \O endstream endobj 351 0 obj << /Length 112 /Filter /FlateDecode >> stream x3632W0P0bc#CCB. HrW02r{*r;8+. ц \. Gz f8\?aՓ+ Ϩ0m endstream endobj 352 0 obj << /Length 148 /Filter /FlateDecode >> stream x3632W0P5f F )\\@`\.'O.p.}0BIQi*S!B4Pe,B<0H2?'8`@?? b\\\cMa endstream endobj 353 0 obj << /Length 165 /Filter /FlateDecode >> stream x3632W0P0bcC#KCB.#3 I$r9yr+q{E=}JJS ]  b<]?``cogcgcoao;V a:z{  2d>.WO@.=D endstream endobj 354 0 obj << /Length 142 /Filter /FlateDecode >> stream xڍ; AЎ+ }燈麂(+G(a1 FC?f˾'5&¬9XywYNql-ࡒDE4'L*Jz#R"?OsՎY o"G endstream endobj 355 0 obj << /Length 160 /Filter /FlateDecode >> stream x1 @D*77@VbBmM> stream x3632W0P0bc#KCB.c# I$r9yr+q{E=}JJS ]*c<]72f?L!fb`?'W nN endstream endobj 360 0 obj << /Length 90 /Filter /FlateDecode >> stream x33T0P0bCS CB. &r9yr+Xp{O_T.}gC.}hCX.O@Pgo9 endstream endobj 361 0 obj << /Length 98 /Filter /FlateDecode >> stream x33T0P0bCS#KCB. 'r9yr+Xp{=}JJS ]  b<]lA 2 rzrr0B endstream endobj 362 0 obj << /Length 202 /Filter /FlateDecode >> stream x]Ͻ @  *xWm[uTt{>P> stream xڥбjA9 {wl"VB"RK-Qԝ;AmbvfsžRC/J|I[ї冊܂}Fn)}~1J~K9yd@ lm9%QX@|цH5`$ƣ{_;kA1m;z4KqͫmЅO@ #"P+ endstream endobj 364 0 obj << /Length 219 /Filter /FlateDecode >> stream xڝпN@ /= MȀ E $"7ԅ)7?W|3.?X @hsoϔ/oW\P懂g[j  }"H;69 !$߱KpWRf $L_QWЛ?N`7Eu2m;i[njAٳakE\ endstream endobj 365 0 obj << /Length 137 /Filter /FlateDecode >> stream x3632T0P0V5T06R01UH1*2 (Ads<,=\ %E\N \. @b<]c u- ? @\ \=7 endstream endobj 366 0 obj << /Length 217 /Filter /FlateDecode >> stream x333T0P0b3#SCB.S I$r9yr+Zp{E=}JJS ]  b<]```` 300H| mo``HF00Fq Ht6t  m g0@PhPh Xiht f>AW p\\\ endstream endobj 367 0 obj << /Length 194 /Filter /FlateDecode >> stream x}α 0 4RZN⤎(>B5 Q4#&4T)Ad} t8E B6( = x$2"iBu]F JxtJfE6YpV2]>w^ca{undv3E-Y srygn0qJq-q endstream endobj 368 0 obj << /Length 141 /Filter /FlateDecode >> stream x35г4Q0P0bKSCB.3 I$r9yr+q{E=}JJS ]  b<](G dQ"- d@ <"yp ap@$'W O endstream endobj 369 0 obj << /Length 172 /Filter /FlateDecode >> stream x= @ Bp.5?bAPKAE;ͣ)-DNa I>Ft0P{(5~43{R|̚T+LUUZ`t^_`v@"Հ#6R0w Y9كz%@C zEH endstream endobj 370 0 obj << /Length 274 /Filter /FlateDecode >> stream xUбJ@ \`8+ h#*p` A+ RPo`XGH"$FcgVl |*Rz|-Ä6%7)1%?R:-ߦQaШCA @a{`0uЍ8 SW}$ s-j)'l\TJ h h'ZLN k>ѧ^eQiaxP}Hv:/~ep endstream endobj 371 0 obj << /Length 177 /Filter /FlateDecode >> stream x]; PEo o6<Vbv'غtn2EHFÅs:XsgyӞd>e8%w!܉hr)-lb^gEihѶ tP"Y~ЅqdXS(\!(iPC] mj7ҪS n1 endstream endobj 372 0 obj << /Length 182 /Filter /FlateDecode >> stream x33T0P0R5T06W01SH1*26 (Cds<M=\ %E\N \. ц \.  ~NH~ ?j?01?` 0L @e5Ȣ ?Փ+ M endstream endobj 373 0 obj << /Length 167 /Filter /FlateDecode >> stream xڍ1 @YR nv6 n!he!Vjih'qGRZp5Lܔs<6lg  ^9l KQ߮z=g|a9Gt)B(PD 1 PBʇK|P\x0> endstream endobj 374 0 obj << /Length 180 /Filter /FlateDecode >> stream x33T0P0R5T06W01SH1*26 (Cds<M=\ %E\N \. ц \. ?XN0 @Ar?``?h> stream x]1 @RnvA"+P,$(!E n1CXs_qxD:qeı,#e5$_l9eE2hKE T760= ӦAޝG4+ Ya|#xxЂf 8 endstream endobj 376 0 obj << /Length 131 /Filter /FlateDecode >> stream x3235U0P0b#3sCB.# I$r9yr+p{E=}JJS ]*c<]?0acga0?`D?0o".WO@.y?B endstream endobj 377 0 obj << /Length 146 /Filter /FlateDecode >> stream x33T0P0bcs3CB.c I$r9yr+p{E=}JJS ]  b<]000 "88{ ?8qV? ?&\= ZP endstream endobj 378 0 obj << /Length 118 /Filter /FlateDecode >> stream x33T0P0bCs3CB.C I$r9yr+p{E=}JJS ]  b<]?@ h ʐ'W =!45 endstream endobj 379 0 obj << /Length 186 /Filter /FlateDecode >> stream xڥ1 0H LHur N(*=Z##tPZ+ 8 B>tLpȋb zƀS .z@)o&(3!DC1U JnjO;'>L^{wf7pz1[y+Y 0/Q endstream endobj 380 0 obj << /Length 105 /Filter /FlateDecode >> stream x33T0P0bC 3CB.CS I$r9yr+r{E=}JJS ]  b<]BTՓ+ ": endstream endobj 381 0 obj << /Length 164 /Filter /FlateDecode >> stream x33P0P0bS cCB.SS I$r9yr+r{E=}JJS ]  b<]3`? 7g?|0o?TTzCuf( H@).WO@.`\ endstream endobj 382 0 obj << /Length 137 /Filter /FlateDecode >> stream x33T0P0bcscCB.c I$r9yr+p{E=}JJS ]  b<]c`1~``">0Z0'r M endstream endobj 383 0 obj << /Length 157 /Filter /FlateDecode >> stream x3632W0P0R5T06V06TH1*26PAc#Lr.'~PKW4K)YKE!P EACv ,yv`Q5 ?`Bd7`? Փ+ v?X endstream endobj 384 0 obj << /Length 124 /Filter /FlateDecode >> stream x323T0P0a3cCB.#c I$r9yr+s{E=}JJS ]  b<]?o^:u?ذ?`$# 'W 1R endstream endobj 385 0 obj << /Length 169 /Filter /FlateDecode >> stream x%; 1F?p۩$:(+PmYf)H"x _u*[}.  ɖ)\ٟhRް-I/R&]/zIOVS6g5\쨞d-yvT"4h<, "2cA.-^I@aIO0hD8'yMk; endstream endobj 386 0 obj << /Length 138 /Filter /FlateDecode >> stream x3231V0P0T5T02V01TH1*22 (Ads< =\ %E\N @QhX.OzE?3L8$ Y0~0`P#'W E;G endstream endobj 387 0 obj << /Length 139 /Filter /FlateDecode >> stream x33T0P0R5T06W06PH1*26 (Bds<M=\ %E\N @BA, C ?b4"Q  A20~0pzrrMs endstream endobj 388 0 obj << /Length 204 /Filter /FlateDecode >> stream xM= @Y B. 8f??` A+ (X endstream endobj 392 0 obj << /Length 135 /Filter /FlateDecode >> stream x3631Q0P0U0R02S02VH1*22PA#CDr.'~PKW4K)YwQ6T0tQ`H``(`   ~$~K  dE@Yb..WO@.gC' endstream endobj 393 0 obj << /Length 118 /Filter /FlateDecode >> stream x3232T0P0Q54T02U06SH1*22PAsTr.'~PKW4K)YKE!hT,C(j  P); endstream endobj 397 0 obj << /Length 192 /Filter /FlateDecode >> stream xڅ1PDPl Ċ1D+ cmq@IA;WL0 v xlagnEt4'g'Ty!n{> stream xڅO; Pl {I*L!he!Vj)h-G,-$q̃T;LNuihuɗV'/2O4Ĭxq7 $$M | ,G\W{F9^ـ"J[|rY"ֱ4nT?pGrjݬc_e*[M* endstream endobj 399 0 obj << /Length 167 /Filter /FlateDecode >> stream x313T0P0U0Q0T01SH1*26(%s<=\ %E\N \. ц \. L@$AD=$? ?@P&VV̌...SG;&.WO@.n= endstream endobj 400 0 obj << /Length 114 /Filter /FlateDecode >> stream x313T0P04W5W01T0PH1*22(Bs<=\ %E\N \. ц \. a`?r 5ez endstream endobj 401 0 obj << /Length 116 /Filter /FlateDecode >> stream x313T0P0V5W02W0PH1*22 (Bds<=\ %E\N \. ц \. c``pzrrlI endstream endobj 402 0 obj << /Length 136 /Filter /FlateDecode >> stream x313T0P04U54R0 R M F0\.'O.pC.}BIQi*S!BA,???PP'W ,5 endstream endobj 403 0 obj << /Length 99 /Filter /FlateDecode >> stream x313T0P04F )\\@$lIr p{IO_T.}g E!'EA0XAՓ+ ; endstream endobj 404 0 obj << /Length 107 /Filter /FlateDecode >> stream x313T0P04F f )\\@ IrW04 s{*r;8+E]zb<]:\={-= endstream endobj 405 0 obj << /Length 110 /Filter /FlateDecode >> stream x313T0P0V04S01T06QH1*26 (Z@ds<͹=\ %E\N \. ц \.  \\\A endstream endobj 406 0 obj << /Length 103 /Filter /FlateDecode >> stream x313T0P0W04S06W02TH1*2 (B$s<,=L=}JJS ]  b<]0 szrr$~ endstream endobj 407 0 obj << /Length 117 /Filter /FlateDecode >> stream x313T0PT02W06U05RH1*22 ()Lr.'~8PKLz*r;8+r(D*ry(01l;cNJ l r \+ endstream endobj 408 0 obj << /Length 251 /Filter /FlateDecode >> stream xڅJA'\!Ls ޱƅ+,J--;y4B[O"hWf,4s n,͡c%:IRc{l3yz|c;9?Tj fDTP&E{h+9G2D~>/BGE$E7~ }KvmV:$,H@%j}W}azH O#bA=b2~|0 endstream endobj 409 0 obj << /Length 263 /Filter /FlateDecode >> stream xuνJ@YRoyMry),J--$ba#*Āb8Gi+9/w]iF ftQ5 sʟjN\`v 1f!]b:ڣ5a&HzЃZ](&Dv) ZEֵ^mVvjRPkY-B4x1+ɛ>[OB:@|ӃFA:nKe4bڈq4Kmۘx~⃌ endstream endobj 410 0 obj << /Length 191 /Filter /FlateDecode >> stream xڍ1 @EGR2'pa!F0Xr!E8 I 33;MR(oSJb:xEk%GU/hvd-Lkg4fAs \102w{(` UO\+rBZt%p#'*=J@ ҿϫFa;Whn I endstream endobj 411 0 obj << /Length 184 /Filter /FlateDecode >> stream xm=` .߁1D'㤎]ċ8p n #~$(}L> stream xڝ1N@4QY AT (Ar 3AzWJ_kN|y9H/vI'Zun8-)\ؙBwoVWg)6r}Gݚ3J~ ZTMa.)- o̤/`tR27V֯ifhh`+-RN]dvg9 endstream endobj 413 0 obj << /Length 183 /Filter /FlateDecode >> stream x313T0P0bCSCCB.c I$r9yr+[p{E=}JJS|hCX.OD|?b0 AD}&> f0H0b!On%rv?s?>  `szrrǁG endstream endobj 414 0 obj << /Length 120 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \. ?c4 N%'W  endstream endobj 415 0 obj << /Length 108 /Filter /FlateDecode >> stream x313T0P0bc SCCB.crAɹ\N\ \@Q.}O_T.}g E!P E >Փ+ HX~ endstream endobj 416 0 obj << /Length 123 /Filter /FlateDecode >> stream x313T0P0bCSCCB.cs I$r9yr+s{E=}JJS|hCX.OLŘN|? ?*f endstream endobj 417 0 obj << /Length 194 /Filter /FlateDecode >> stream xU-@%&c 迨 P$u[GEev K1h8&nL؃-;CFXA_>pi ?!&+R"c(ɉ(N+ƵGSroW\"Ϡ+tIߣmśh5| dXB]/qs| endstream endobj 418 0 obj << /Length 170 /Filter /FlateDecode >> stream xŐ1 @ERxt)R-n!he!VB9EqW7seϨxAƘxң3U5ݮr 쀾"h `,T'uID x/H 9 Zpqol endstream endobj 419 0 obj << /Length 174 /Filter /FlateDecode >> stream x313T0P0bSCCB.cs I$r9yr+s{E=}JJS|hCX.O0"370`H؃@`?#^^Q`Cƃ-Y  f $700 F"b\\\wN endstream endobj 420 0 obj << /Length 236 /Filter /FlateDecode >> stream xu1N@ E"a|$H" * DH$*\!G2HQwmT 娔DJsՠg?x#Um<>r\Iq+wn˜24wC0MLNLtA 9a=tC68yF̛aO2/a<&E>oxv endstream endobj 421 0 obj << /Length 124 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \. @†H0 z(QՓ+ +T endstream endobj 422 0 obj << /Length 226 /Filter /FlateDecode >> stream xE1n@б\ M<'m JHqT)"*L(iRZt)GLᏱEW23ɢ}ɟ\YV>>xUs&Ւg9pzy^Jz-NS={kg`g?EJEAJ>.dt &JI0r熻qM 5.M_f[݆{GZ>_?WKq{ endstream endobj 423 0 obj << /Length 191 /Filter /FlateDecode >> stream xm= @ x Ղ?` A+ RK E[)S,;h%Xfh< }:ex\T:8^pVQ>EmqF;)C}FE$ sXBט^Hȃ@?|bezYETZ_q-`R!a~K<.Kj/\ endstream endobj 424 0 obj << /Length 187 /Filter /FlateDecode >> stream xڝ= @g"#Xraˀ!N;GYg!BR@[]/w%ܔ|q&?,Lƹ+x"ҡ@yRx -0遍~*?umֽr!0e] EӐ`%Ж*sz endstream endobj 425 0 obj << /Length 182 /Filter /FlateDecode >> stream xڍ1 @EIk9 n!he!Vjihh%GL2Φօ}g?ofǜlS>'t#k5?;2{Zd܆L]rBC\"iJzD=[5/jLAOQ~ߏ@B_Zh4J5Ϋ^RMuZ9uEJ endstream endobj 426 0 obj << /Length 193 /Filter /FlateDecode >> stream xڕα@ .<} L &`qRG;[pqᾤ 5)+H+9s<^&|XLפ*L,r0S⺡MNMC $z11wx!"><Zi&N?>cH RaH'c ˁ:ѴmO, YK endstream endobj 427 0 obj << /Length 201 /Filter /FlateDecode >> stream xmPE4K BBrmM>}}V́;ܹiԥS=T'u9&a+NFF⻥OK+ VZ[( f#2;܃J>PDCv@Z }•cC 7'* 4u.7mp b2rcZI_ endstream endobj 428 0 obj << /Length 154 /Filter /FlateDecode >> stream x313T0P0asSCCB.c1s<=\ %E\N @BA,@Az H?*;&p4Aka[~ `1.WO@.^ endstream endobj 429 0 obj << /Length 253 /Filter /FlateDecode >> stream x}J@#E`}!k.p` A+ RK E#U(y[,gǰzqꜟJz`;볟 Z.(wk~x|ws%{/xv4lnfxYDdItSn\#7@efd=`El6X4jB*`f}E_h0bj1SL̀,x>v*!*:MƢ:?-y%ۧF@-7> endstream endobj 430 0 obj << /Length 161 /Filter /FlateDecode >> stream x313T0P0bcSCCB.1s<L =\ %E\N @B4Pe,B @d ?  B~oAd $?HzI8'W z endstream endobj 431 0 obj << /Length 132 /Filter /FlateDecode >> stream x313T0P0bcKS#CB.cC I$r9yr+r{E=}JJS. @-\.  @x@@?C1;}pA|.WO@.O) endstream endobj 432 0 obj << /Length 198 /Filter /FlateDecode >> stream xڝ;@%$p.H)L0VjiVW(x[_~0E_cƃ=2b4gA ΄Sp)-8lsQy endstream endobj 433 0 obj << /Length 115 /Filter /FlateDecode >> stream x313T0P0b ebUel䃹 \.'O.pc.}(BIQi*Sm`Pz<7,{\W endstream endobj 434 0 obj << /Length 171 /Filter /FlateDecode >> stream xڽ= @[&G\@7!Q1#X^,7[n8ȃW3r9Al&]'-\,cx܎` s0 n ==Cbq1 SeKvI'mr/)T8R`5zf endstream endobj 435 0 obj << /Length 155 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O$$PD2`$ȃ@H&?:7 q.WO@.ll endstream endobj 436 0 obj << /Length 183 /Filter /FlateDecode >> stream x}=@XLvNBLH0XF[٣Q8ab^2}KJ)*%Kw4 +@@)juE]VQzB[_P :9o.A@9(dq%7@'a/=ߵG.^Tyh p A!\\[>P: endstream endobj 437 0 obj << /Length 200 /Filter /FlateDecode >> stream xڥ= @g fI"SZYZZ(ښͣ[.(wS|7q4HRYs_8 LWCNv?$#(%p:lHj&5pGٌs V,S*7;(&A]t, -GT@8=F> $_ȥF<5ޯ endstream endobj 438 0 obj << /Length 158 /Filter /FlateDecode >> stream xڭ1 @ПJuj!Fp A+ RKAEh9JAqc![̃I`4-ØԈmjw쎜{Vky\Y\/|9êe_Hx+5C8#$RC\B"xo<Iw endstream endobj 439 0 obj << /Length 185 /Filter /FlateDecode >> stream xM1 @4!s7q5@T0XErr,,2ԎgDM&rv=pr^ًYMyaoY!RrGB7 }KD#"eZSW!("PB Ca}96A=> stream x313T0P0bc 3CB.cS I$r9yr+r{E=}JJS ]  b<] @AH2`h AA~[@ Lx:B endstream endobj 441 0 obj << /Length 148 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O` $0()D? d=H2cģd> endstream endobj 442 0 obj << /Length 186 /Filter /FlateDecode >> stream x5= 0W:oN`B`A'qRGE7^̭ ء4ؔ? ,&Q@>0[}pb*Q)QzܟvI>>yG:J^]S |-,ZHZX:^<r[C准qzb&gaQ$L endstream endobj 443 0 obj << /Length 174 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O `?aC00~ @2?Dv`N2~+ߎ #ȏߏ`` ?G#g``?A6 H@RՓ+ ɝm endstream endobj 444 0 obj << /Length 202 /Filter /FlateDecode >> stream xE; PEoH!LUBBBN!۲t @!L@,a̻{ې lfOÄܒZrɌOp>ܘW!kJ/LnRQ;H(+p{h/ O.ok> 44W&F&R$}xY& endstream endobj 445 0 obj << /Length 237 /Filter /FlateDecode >> stream xEαj@ dz)CB=ҩCɔdnvj:t&=$%p!:d-"zX!ZnhyxDQd}LKႲ)ֳ[{vȭ+OPy5 @U-G[;z[*lB;v\ɼHer;SHR Z88 ~Ka{ endstream endobj 446 0 obj << /Length 176 /Filter /FlateDecode >> stream x}1 P S2Y<9*BV N⤎G(Ϥc|?!?'S3>gt#͔+^wr~ÏB.9#W!H"Px+"B I / >i`$f_$hj(D{{-ӎ~b endstream endobj 447 0 obj << /Length 203 /Filter /FlateDecode >> stream xڝ= @_L#8MLRL!he!Vjih'({!q-6߲`}t!'<8 91 ũ piNfqJf)c2ot=̜w{@^m W÷x: dTLdO_'X`*w]!WҢqz9KU" }}d endstream endobj 448 0 obj << /Length 141 /Filter /FlateDecode >> stream x313T0Pac S#CB.# I$r9yr+Yp{E=}JJS ]  b<] X큸7001;j?0FJ endstream endobj 449 0 obj << /Length 222 /Filter /FlateDecode >> stream xe1N1E*i| .-V Ab $(UAݣ(>B,?kWEwk.i;O%/$=iI^>$nF6x0ڄʬ ͎X⌾T~fGvlgOȠ<|HTGǂ+ˇD5WTL3*=2,<8h endstream endobj 450 0 obj << /Length 226 /Filter /FlateDecode >> stream xEнN0 J^ @ZHHCL @>ZlDZTe}9W|Qps}ů}PYkP|N#5[ Sj~??ScNzDDFM&4=:4WL hLVښQ5A1;,wKi sęǐ dw;-y"ͧ\ۼ>[z3Vc4 endstream endobj 451 0 obj << /Length 181 /Filter /FlateDecode >> stream xڕ=@!$p. b&ZY+h pJLh$%^5Y (xTHN)74 U[QcL uMĄB9ƛG3a(if M( /#`cV2OZ˿Z;5t endstream endobj 452 0 obj << /Length 207 /Filter /FlateDecode >> stream xڥ= @4{t&)!BBB,xxqFE惝}ov)ZRGk;Sʱڬ)Nюe6aܠOi(Zb>$\Cǹ.5Tº)7 P \)'ߘ'-,e$9ґ i `AY ֚ G9-c endstream endobj 453 0 obj << /Length 241 /Filter /FlateDecode >> stream xm1N0E"4 @TE"Th+)S ͓=3uE5w|pWs/ 5gFGn{n5j+UknS=6@! `dHp糢0g0p \ύF<'"DMbLz[Zj6]*7DE??(jALP5ˠGԡ(OY*G@BR栛 5pI endstream endobj 454 0 obj << /Length 183 /Filter /FlateDecode >> stream xڕͽ 0+- h NB`A'qRGE(}zWEq _~3#)';#I~C"cQ8|Q iT5t] '`010%p1 iBt*Rt 2;nB)4_T+~Ѭ.:\M endstream endobj 455 0 obj << /Length 213 /Filter /FlateDecode >> stream x}O @`qM>!zI 0XɧSW؈p w3s3Y:'sÄ1P{~s8Ӵ$4'tcot=w {* (D`D:y#jAԠBQSQ]9h@9׆mƠ3/"-PIoәn ժ?|R3{6nR}Zn endstream endobj 456 0 obj << /Length 245 /Filter /FlateDecode >> stream xm1N@ Ema|HBbE"Tj`&GkH 4أnv+4rVISJ{!Orݢ~9^ꖋknR*.PI^((`)3Sژ1+-:%8p'?, \%ᔀ^ÊH"4)MP9%7Hi/! GdL!n&{| JMc_u|_!r endstream endobj 460 0 obj << /Length 220 /Filter /FlateDecode >> stream xڝ; @,q yЙ(鄨` A+ P,F\”!R,3Ł> stream xMбN02Dŏ{HBS SR$2 1#n5dPz&%ٺϿܜ Z3Y^soXXr> stream x]1@E?bi8{ b&ZY+h ތp-)@,?̏׋tBӡo=)NXΰ>(7O*NH%mI燍HBP=Հs[Nt׃C`EY()j kP`5WGƩt-pHW> stream x3230W0P0acSKCB.#rAɹ\N\ F\@Q.}O_T.}gC.}hCX.O ??#! F#.WO@.cQZ endstream endobj 464 0 obj << /Length 173 /Filter /FlateDecode >> stream x̱ @ A{ VC NT>Zpcz1䢻CјBd& "> stream xڕ1 P PӊcV N⤎h=JбC3/_&)[*<[э[qX{2{ɬ~ÏB&.ّ)Q B(F]#n0nPAjd4_A~|>KFAVLՙVv›k endstream endobj 466 0 obj << /Length 138 /Filter /FlateDecode >> stream x3635R0CccsCB.cc9JrW06r{*r;8+r(D*ry(0c aHT7AT? H0МN9V endstream endobj 467 0 obj << /Length 183 /Filter /FlateDecode >> stream x== @'49B;SZYZZ(ډI(R!8~O;ڭuAҌ sqKM3qSN3=;qHqc]%YK>V M3DKWĸPcN, =᭢7b[fe '?f5̬ELrYR endstream endobj 468 0 obj << /Length 143 /Filter /FlateDecode >> stream x3631T0Pa# ScCB.#3 I$r9yr+q{E=}JJS ]*c<]0@3GPq1B?{3g`d'W SOv endstream endobj 469 0 obj << /Length 202 /Filter /FlateDecode >> stream xe1 @ ic1),J-- XXz+ (3SXcYv}adžp=Ye N_ q ~:?^Lri9=cux[t1TFl^fbհZ6.j"U\syE>vWoעHiQfF꜆dDſ0Ma _Cj\ endstream endobj 470 0 obj << /Length 179 /Filter /FlateDecode >> stream x=ͱ @N( rjjjl( }Gpt5|rj>YԌՂ/!I-O{8(HX$7XIf[~>^WnXS>"9Q6u+ƢlHpGFn/rb}D |$PH|$Vd$BR@W6x?hO\ endstream endobj 474 0 obj << /Length 189 /Filter /FlateDecode >> stream xڝ1 @EL70s @BBZZ( 9Z#XZ:IVt« 3Or#xjBN%7nt8SjImYǤ+]'RzΚT;l@TJ @ hxjze/ ]a;AdD/ak+?iTRS" }G@ endstream endobj 475 0 obj << /Length 188 /Filter /FlateDecode >> stream xڝ1 @EL/ :ͮA"EVbE$Nxg1q߄l">h.!Ǧ^OXRcR 7'e|ޏՌ5ٔs@ th~//iKxO`LГtIVx?>(=Cuڕ/@RriniMoEBs endstream endobj 476 0 obj << /Length 130 /Filter /FlateDecode >> stream x-ɱ 0 g 2'0-k3:9 TGAEfڢ|7lXU:x@='e; m;P=fpq}kw+*\ǣҟ;ZFy2ddL*R!sBY ,P# endstream endobj 477 0 obj << /Length 131 /Filter /FlateDecode >> stream x-1 @E?^ xЙmV"RP:ٙ&Nwo\%红V\xA=y1:nwՇ Y/ t4M22DT&2+<*B# endstream endobj 478 0 obj << /Length 94 /Filter /FlateDecode >> stream x3230W0PaCsKCB.K &r9yr+Xr{O_T.}gC.}hCX.Oz 0X [\w endstream endobj 479 0 obj << /Length 101 /Filter /FlateDecode >> stream x3230W0PaCsc3CB.K 'r9yr+Xr{=}JJS ]  b<]d7`= 1S'W fp" endstream endobj 480 0 obj << /Length 140 /Filter /FlateDecode >> stream x3230W0P0W54S0P06SH1*24PAS#Tr.'~PKW4K)YKE!P EA 30` Px҂!Փ+ &, endstream endobj 481 0 obj << /Length 94 /Filter /FlateDecode >> stream xM=@PEx$^!R { T߱4J2:*54`ƴ"f@BJJ7"i endstream endobj 482 0 obj << /Length 172 /Filter /FlateDecode >> stream x3134V0P0bSKCB.# I$r9yr+q{E=}JJS ]*c<]0A?  @CA2@5@D!dPICd \\\^ endstream endobj 483 0 obj << /Length 175 /Filter /FlateDecode >> stream x331Q0P0bScSKCB.S1s<L =\ %E\N @QhX.O g``~?`g N}`o`F¢0?Q\\\ endstream endobj 484 0 obj << /Length 208 /Filter /FlateDecode >> stream xѱ@?Xf!FHJ"BJ--|1}_aau=΁egM]p,+qeL?&wXis)|›p1$Myƀv3|-{Pe!,GpPghFdPCWT-kCj( gf"{![ޗAftC endstream endobj 485 0 obj << /Length 185 /Filter /FlateDecode >> stream xڍ1 @ LMBVbv9Z#L!W0as_DhO-%CX턏ӆt2r@:兜YMz&cPpte] 0.,$+IJ_Fn_o^:, v;r endstream endobj 486 0 obj << /Length 235 /Filter /FlateDecode >> stream xmj1 ^=;Od-$AhO=Xބͣ{N"Q6>fB&?N'izmf4Z||DJƠz.rM/T%V~rEP@X8 \IU{3bY1Ez$'i=Sː†LBp6Pu 8:R [49޲&&Z'XΝ_%m endstream endobj 487 0 obj << /Length 260 /Filter /FlateDecode >> stream xڭѱJ@? LaZ 4ܪ[-'BBRP̛*y+uvg!B#n;MG4Zly\Ѣ瞚-Sӟ-5#%_v^QdRPDZTRR OԵ@*(AWE],RIR57P&?2oƐ(~#FLg5=dF#zvL;mf&,mXJ[a # }R:%e-vvS=U:霾es endstream endobj 488 0 obj << /Length 166 /Filter /FlateDecode >> stream x353R0P0bSCSsCB.s I$r9yr+s{E=}JJS ]  b<]d `6`RAI68؀L2`%Hv0)"G'!P5Ⱥ AJ$ `G@%\=Mx endstream endobj 489 0 obj << /Length 125 /Filter /FlateDecode >> stream x333P0P0bSKSsCB.SS I$r9yr+r{E=}JJS ]  b<]?T b78) s)hb y.WO@.!7 endstream endobj 490 0 obj << /Length 106 /Filter /FlateDecode >> stream x3ԳT0P0aKSsCB.#3 I$r9yr+q{E=}JJS ]  b<]acW3v\ endstream endobj 491 0 obj << /Length 244 /Filter /FlateDecode >> stream xu?kP{<0p '% ur(vtـ]G|X#y=8. [~< 8:İ˵W|Ք.1wQ@jH>yo瘣1 ý 8hFx]*18yTB,a PM 2< fep\$I5+zG4VY5D NZ@fW'coQ! endstream endobj 492 0 obj << /Length 239 /Filter /FlateDecode >> stream xڭ08#^@D'D::htGxWm~_LyxJsNgo(I5M7?/&~I#K CԼ*x1F%)dB 񑊅A8EjGU(Nk4, ~j}> stream xUϱN0 )K~h{=B @!Z̏F%Psw|J8êt0r^jE>U KWk=?ܻbuyJz_uEk?ƌ!fl#>3Z;@'7x &&ȖNm9R0!G/aEFD+E$ьMX^>a-M=:upǴ-i}GA^{sywָ+=# endstream endobj 494 0 obj << /Length 150 /Filter /FlateDecode >> stream x3Գ4W0P0bSsJ1*2" Fr.'~1PKW4K)YKE!P E?<@0g`A bP>T*L`)`J+F Hʃr Wr endstream endobj 495 0 obj << /Length 191 /Filter /FlateDecode >> stream x= @B\@7JL!he!Vj)h9G,Sl3X,fuVsmnFlzl @Hw4HH/I'S>[ِ҃C#^(>l \3X~ZPCAJ'BEH?4u7{-'ROr%xVݙ÷C qBszxa endstream endobj 496 0 obj << /Length 307 /Filter /FlateDecode >> stream xu1K0W v8b vtr@?')ΝCMHH^K^Y/PX.8\> stream xαJAYL"y.p1bLBASP=p2E8n@,ofgɌKWR+s8 5srzJ 5W7Y ~k%vTZ^{cٳUoC0˖*STB`ζ&%EQ0b43e}"_馡}l endstream endobj 498 0 obj << /Length 204 /Filter /FlateDecode >> stream xm; @ . Vf.1L!he!Vji(X({8Qښ}i<"Ńf{Qj{T3Qes:.{TŘ4 5E&6%/_x/PAP02g0yp&dBw:+0}ATyM6Ӣ5l.5iK|T endstream endobj 499 0 obj << /Length 198 /Filter /FlateDecode >> stream x3134V0P0R5T01V0PH1*21PASKLr.'~PKW4K)YKE!P ETD0S$00|`A; 00* ?8Q"I&PMb`߁q ̍:]'W ckA endstream endobj 500 0 obj << /Length 182 /Filter /FlateDecode >> stream xڍA `'?(   AZDjX.̣y҅Tcu 7f: 5P L % MBb%_/#jƒ&Ύ҄Z{Ue5TƩ-ՇW6j@-OӉ;*`{^[bTd7 wSZ= endstream endobj 501 0 obj << /Length 198 /Filter /FlateDecode >> stream x3134V0P0V5T01Q0PH1*21PASKLr.'~PKW4K)YKE!P ETz !HԱ` |P=iu D)ph<krF=A?0`> stream x]1 @\B/ 8M(+Tr!bI q23;9nvdC)lGUgwIBf6$32d@fr@&m)2ϩ\^sϵ2HQRQO5QJrh MTrL@V@ endstream endobj 503 0 obj << /Length 141 /Filter /FlateDecode >> stream x3236W0P0bcSKCB.# I$r9yr+Yp{E=}JJS ]*c<]70| C`003a`\=&[ endstream endobj 504 0 obj << /Length 237 /Filter /FlateDecode >> stream xڍJ1ƿ00 v^@9Å+T[}> stream x3134V0P0bS CB.C I$r9yr+r{E=}JJS. @-\. ?&iNa`D~700n?D䇁$7 \\\y endstream endobj 506 0 obj << /Length 122 /Filter /FlateDecode >> stream x3230W0P0aCS3CB.C I$r9yr+Zp{E=}JJS ]  b<]0@A@8~? q0\=(CE` endstream endobj 507 0 obj << /Length 150 /Filter /FlateDecode >> stream x3236W0P5Q54W0P05SH1*22 (s< =\ %E\N @QhX.O  P?`E6?gc?P~.WO@.W endstream endobj 508 0 obj << /Length 196 /Filter /FlateDecode >> stream xڵ1 @Еir3'p.#BBRPQr0E:? d37u.{ʧHrCqJzƁGz$15x2`ts [R?L3؂rkm;x3HKv@%.oԐ nn**ɍ@ÔDr endstream endobj 509 0 obj << /Length 108 /Filter /FlateDecode >> stream x3230W0P0aCS CB.C I$r9yr+Zp{E=}JJS ]  b<]?0! ̃`qzrrƂQ. endstream endobj 510 0 obj << /Length 177 /Filter /FlateDecode >> stream x33R0Pa3scsCB.3 I$r9yr+p{E=}JJS ]  b<]?`@=:773n? Da`N``` O7Nszrr#߈ endstream endobj 511 0 obj << /Length 147 /Filter /FlateDecode >> stream x3134V0P0bcsCB.C I$r9yr+r{E=}JJS. @-\. ?00`D~70n?D䇁$0I.WO@.e% endstream endobj 512 0 obj << /Length 188 /Filter /FlateDecode >> stream xڍ1@E #0e6 &naRK v9GTd)HN^f̦ǚ95(EqߜR{cRkI ? ldM*H&g8^WSQdHVR!J*- i~ nN/ookg$AH> wlzZIK endstream endobj 513 0 obj << /Length 196 /Filter /FlateDecode >> stream xڝα @ HByuj;:9::(>Zp"]qQ |CB?2ܓ1G!#I:Ramd$V$fO"tٓH$R^K6ʯ\UW0/%>T5*4hy~> stream x31ֳ0R0P0V54S01Q06WH1*21PAScTr.'~PKW4K)YKE!P E0a<|?`0?> stream x3635R0PacCcsCB.# I$r9yr+Yp{E=}JJS ]  b<]3P?n3 ~o0ah`?PszrrjF endstream endobj 516 0 obj << /Length 195 /Filter /FlateDecode >> stream x=αJ@Xf x{`TSwZ * W6`"8%Gf|q~K.4pR^j<> stream x363T0P0T5T0P05TH1*22 (Ads≮=\ %E\N \. ц \.   W  @ @,?(fQ 0pC sC3=;?f.WO@.uH endstream endobj 518 0 obj << /Length 153 /Filter /FlateDecode >> stream x3134V0P0R5T01Q06WH1*21 ([@ds<L =\ %E\N @QhX.O `J`pB`왏I@.WO@.1c endstream endobj 519 0 obj << /Length 183 /Filter /FlateDecode >> stream xU̱ P#k[WJ' rjj Ɔh>`Phj @ B\Q#HEldȗ$"Sg3:.{|LVkRj_ ..X ,g0i) <p&A=j|c(vk]b=(ԿOI |F? endstream endobj 520 0 obj << /Length 233 /Filter /FlateDecode >> stream xU=KPs Xxv(zb`A' Q|A7|~Lx`7UN?8g!Aj"z$r~nhdHڙdrO/$GcHN* WUP6Aߴ45q " bx%tq_cGŲh;L t5<fOk2|+ZlECd(IBY_ endstream endobj 521 0 obj << /Length 210 /Filter /FlateDecode >> stream xMν @ )(> stream xUj@Yi nZ$sSEGQ|x I;=F(N8^D!qiIs ǔB3I-1QYAg//74gZv* 0ÿ+]SCE@QsϰF,IqSn/'gCb^mmjg`1'>ڟK endstream endobj 523 0 obj << /Length 183 /Filter /FlateDecode >> stream x%1 @@$|'0+AA),DQI:IUuO)Fh~!;:c̐ېዬQ֑)HpIH]RY#H[m(l2Oe-?uC endstream endobj 524 0 obj << /Length 188 /Filter /FlateDecode >> stream xڵ1 @EH!L#d.ͺB` A+ RK EBbGRRl6Pt+ǬƬ5$Ii;Xf$#aI,Dv$f,I(K~ |[jWopG!SE /zO6x+ӸY~uд` endstream endobj 525 0 obj << /Length 121 /Filter /FlateDecode >> stream x3135R0P0bc3SSCB.# I$r9yr+Yp{E=}JJS ]  b<]0001; aX*6T?0'W N endstream endobj 526 0 obj << /Length 228 /Filter /FlateDecode >> stream xmαJ@o"0M^ป'pWSZY `eh>J+5E~;Yct_^iC-/+9u'Zst }{} ,, %s'l"aAZқMY'W Tc| endstream endobj 527 0 obj << /Length 235 /Filter /FlateDecode >> stream xu1N0ЉRX`3',ZiY$R AE GQr[0"OʌǓ/^ҟ+Vɾݭ%+yxb>F:iy-29Q EPE6fLV&b&e6fՎY (y/ifU _ cBԨM>y2_ |Ǜjh endstream endobj 528 0 obj << /Length 188 /Filter /FlateDecode >> stream xڕν @ + At-('𮶵kotrP?Q_ I+F!=ړ,o)$G$'KROt8oH&{$S^zVSBĢ iAf1h.p;`Z \2oߛy544` endstream endobj 529 0 obj << /Length 226 /Filter /FlateDecode >> stream xڕϿjAna s=b!j WJ!`R nGG8̜EH:_1;dySpnyΟ9)_6[d?9oR&[}";YL9#;e銊Һ„pQ*+j .+xs7xĕ\ }rR /:tKuNTc'ې'jiT2Dׂ+X endstream endobj 530 0 obj << /Length 243 /Filter /FlateDecode >> stream xmJ@O"p}dXW0 j)h()SDm>{uuVZjG+9}Mjag"VNbkx|JV+-*@ Ps&[ D>#E@rI~2> stream xڕα @ HB}Ѽ]`A'u(GQ|TZ?$w#3ihdȎhC!s8cТZp*Yz?WS2f5wHPQY 4a:B@ 8 1n -SQR-8 d_Ѯ+J_> stream xMJ@Eo[8м$AB`B]W҅E ;#Ǜ*y{wquLZZj}%OR7KmN~&wlֺ₲<>H\i%Jo*-o])L O[ `;d1a3X`LpM6{{xSHp|tO01l6 i4,e3zwgRS@v伕+c endstream endobj 536 0 obj << /Length 150 /Filter /FlateDecode >> stream x3632W0P0Q0R06CB.#3%X"9ɓK?\ȌK(ʥPRTʥ`ȥm` *og`?: A u } )v endstream endobj 537 0 obj << /Length 119 /Filter /FlateDecode >> stream x3636U0P0Q54Q0P01WH1*22(Bs<=\ %E\N @BA,C dXlt5# 'W v)1 endstream endobj 541 0 obj << /Length 136 /Filter /FlateDecode >> stream x323P0PP5T02P04PH1*24(YBs< =\ %E\N @QhX.O9   fv6> $'W  ' endstream endobj 542 0 obj << /Length 220 /Filter /FlateDecode >> stream xڽ=0$N`!!U'D::htq@ZmIjlB-$CϐOj^gHs`[1e ,_z?Kse0C (eml dE|QbM*mhVK;-Fi,IUAmluΧl.CNZ=xں%giz@6 7 endstream endobj 543 0 obj << /Length 171 /Filter /FlateDecode >> stream x1 @ [~/1FJL!he!Vjuh%GL7pWjRVsȣ BRJœϲ?SVp\ؚdq$fyQ3ƴ_@ x6QjykaD D~:Vht%7Tm endstream endobj 544 0 obj << /Length 160 /Filter /FlateDecode >> stream x3731R0P0b3s3 CB.31s<̌=\ %E\N \. ц \. A70``a~@ m :y 4!B3  4'W +q endstream endobj 545 0 obj << /Length 229 /Filter /FlateDecode >> stream xuϱJAba yh+RPK E;1 tƽpS|?;?xžjs3TC=-r+SrgkkrKyrM͒a{ծlB-`a:`u)xuwGW2&e˯ɦnh huaǨk} [ bԪob"EzONoɌla endstream endobj 546 0 obj << /Length 210 /Filter /FlateDecode >> stream xu1j0g<7 41'z(S$ MHXGQ|JW\(T 7uN3uki1}.Gq%Cf&u#U])Yϧz\R׹fi WOp_PI! I@*#f%#~,K{ǏT#,ΰq`(nYsLޖF^V2 endstream endobj 547 0 obj << /Length 203 /Filter /FlateDecode >> stream x=@H\@ȜM B0X({+ba8垫|>2Pԏ~?Ѥ$|@jRRod5Ԍ;*gX@l$u8lSyEȞn!X#xiTCƩFHjODO'0vBJ#n $"&ݏ endstream endobj 548 0 obj << /Length 159 /Filter /FlateDecode >> stream x3534W0P0bSCCB. HrW01r{*r;8+r(D*ry(0a@R` `$@z ɀ a/ m?C&\=?qjS endstream endobj 549 0 obj << /Length 209 /Filter /FlateDecode >> stream xڝ= @GR2MtbSZYZZ(ډr2EH|((v̛ݝGa_ endstream endobj 550 0 obj << /Length 218 /Filter /FlateDecode >> stream xڭн0 p[*y#4"t7p  }4бCHpH'n[~8{`zz9> stream x36׳4R0P0a3CB.c HrW06r{*r;8+r(D*ry(0`?l(g?6g u@lC{ pP endstream endobj 552 0 obj << /Length 213 /Filter /FlateDecode >> stream xMͱN@б\DTd""R.HE) h!kfg:[\ꗺXS)Ks"Z;׌oY2=7Ro0ͬ&a8YZi4 %:1X[z83L̺E[y!8}?+O2dWtm8 \\ղuY endstream endobj 553 0 obj << /Length 160 /Filter /FlateDecode >> stream x36׳4R0P0R5T06V03TH1*26PA3#Lr.'~PKW4K)YKE!P Ea9$luPفX$N#Ccagc{  00?r Jm endstream endobj 554 0 obj << /Length 162 /Filter /FlateDecode >> stream x1 @ᷤL fqC@Vb--+'Gˑ<@Ⱥ!X l3pjZ>DŽm:L#c^[z?.6 6KNJV- -reByDz 7U}`(D,uxI0nҷWR hhKob endstream endobj 555 0 obj << /Length 202 /Filter /FlateDecode >> stream x]= @Y6sݬ+0Z *ZGQr!n5|ś7ȈBR[^0$)?G19]/bLւ :c:k{-Ŭ`m88u t&p2 lB̘Ϙ> stream xMJ0?0> stream xeпJ@o \`^By]  @-G̣R^w]9 Opj8>xPS5ZOLIppu%?^^qDzŷ;JW\ׅˡ~ lr&Vg{'´N2;s8Gvn=ЪQob]pл ~^8:g007~ʞJT Ͼ4sM^!yJ[X' endstream endobj 558 0 obj << /Length 207 /Filter /FlateDecode >> stream xڽ P FҡмVn?`A'qRGE7f}>BŚނ*3$|9VuQۀ}+5͞1%kTڤ|18Ux*%V738 \A&rOP deyܿ>X ?c\%#'q(IfNĴ) endstream endobj 559 0 obj << /Length 131 /Filter /FlateDecode >> stream x337U0PbC33CB.c# I$r9yr+q{E=}JJS ]  b<] >00013 A9 CaՓ+ t^@ endstream endobj 560 0 obj << /Length 259 /Filter /FlateDecode >> stream x]J@Of!"." E0pA.Z v |˝gH0??pNNmnҮwYUϹ勧7wk"nssa q[{_AꭅBaD4%;>#p{%*édlW]HO˷df 3ÂױtK҇FoMfl=o,"E"pLΉ~WhFF*4& !3DWZnvj endstream endobj 561 0 obj << /Length 206 /Filter /FlateDecode >> stream xڥj@@CkB  A GAẸMb/hffӱZ'd?$u{<l(潽x3\h*fTK> stream xuJ@O};/I$7 \` A+ RKAE;Gˣ#L2&" _ɚ3.5%LErHk.2J__(\rNorn2 h!P#a]a:x-}bh~mh!?0B~! ?#;CsŨ^JԴIPG^`M !A#`xBo~^}gt tچpYzLG%NC:k>y endstream endobj 566 0 obj << /Length 382 /Filter /FlateDecode >> stream xڝ1N0D,yJȀb J(> U)",eUM~VJ^R, bm~|}gOvc;^|}~|p#$˷YU[LU7KeYF-1zVt qV9-Ti̬jcDG:U#F)R]"X )h[7(RfRd Vi%(E:8A}$](E7URhw.BL^dx')z TT2%AaΕ[Q/a`D a¢jBLx5 J%aQ4>TɨW;N˹IA 0!@Cn+~?]T endstream endobj 567 0 obj << /Length 200 /Filter /FlateDecode >> stream xڳ432Q0P0bKCK CB. 1s<,L=\ %E\N \. ц \. ᠁L$<Ɏ`2" Hz)ɏNɌHH3 @$+G0L0&D2\d 9iĄQ&$B3L.WO@.up endstream endobj 568 0 obj << /Length 493 /Filter /FlateDecode >> stream xݕN@ǗPlo  \a#y&RheaBf-%a@0K7,;>Zx7pY?dnП qn ͚&j&%}y{g4یwqZ)kLց&{1:ܚj&+&$4tg`zz.VcmMg:mD?pjCdCe`6|wn 50 9ʞ  |F˹|$ZyI/!s T0@*Aj &l`8H+ (& 8ErBqYv KU4(4B#񥠱T"DT*me +i;p3p`y9~9pir&O8\C92 ya;`v8UCs`~5 endstream endobj 569 0 obj << /Length 296 /Filter /FlateDecode >> stream x]1N0E"\)sHR4HE"TjA-G\0hŒO?h,5yK%k5k(2Uof7Էrm>?^M{zjy6Þ1 (+bv`柀UJ"~# N>t%%1!*0jQAzj:ޖ> stream x= @ )2(I#XQr)uv! jc_13{b-lHlH\J@2$]kH)F1!AtG "Ù`*Coz_kjSӵrgFOT&.Y<,I(d&t^Pkԏ-b0P0+f endstream endobj 571 0 obj << /Length 319 /Filter /FlateDecode >> stream xڍ=N0F'Jɍ$,-D $(KI:(VnrR2|Ю%[o쌟f]s֚ڜcjsyazSۓ<}Ӷ[ݕiTu0Tw01T4"LBG `"'$$PƌDPiMB A-BsT'!Q(+Β[>5PK9NT> stream x\m>k$zv3pKnK [&6==T$VW=X,]SRIȇ%M&x()ML̓$j<' e?eǽKZFA6"q@#`)n:a 蔴+w^ȂL.M$DJc0T2\$2a1%()S~SDni+e3  D{]}A] ڮ@6, F]լ+U20]PRJ F :XJaax guUxaܠq+OHu;feem,LX_qe499}IMem[ڴdw7wx?Nbar~z{Ư?~xfKnbZ*k!ԭZPNGZ nY-`?}OOӛ߽ϧ?xǻbv>w|O?<~zV>szA6p-yuJ^wR*=朶m|ica`E!JsL\FvY6 YͲyY~Y˒/[l^t˩Za11׼xwJo>׷t+ۥw#S^ACdeou:NO~O|Zκᇏ[5F*՘yeAS 8Yo {0X?Wy ?v~㏸ZY/ۏ>je Vמ(q/5`Z )ndŌ7,&)\Vjr1ɟeZ&k)|0e0Z pr+S_nzݨ0oWO~0Sr0Ea͕VZ+gϵhF岖75 -$Wq=16`CyK5 65hj@&%?@]ėUY+7-[Ar<lk@ņC;zT!e/^ .Vj՜VͥtƮ{k\\ڸ(-}. ՚Znԯv΁˼Q=R:vvR9_tI:L{w}q:w .Q -haQNU.>}T%'q h.] ohĈ>~10 i򄱀I =f0;<_}rOЯ~z)֏4OӂO>gP"USEaKg^hE{x˰zQXd`oueL2p&n=5u !4D49\SBk A{4 A}t4f626(@35 !E AƩQ6NhFp8iXT'Q_[y%ߚAf Mm}adF3&joI7MJ)q{S m0Z m6DrAq ӱ:;vХo4ry 6Qi >H$р0 !ӣT70B L PPsRHPP(P`s쨨pK%iؓ\ OЇo>ʟŗrR> P>+Wji~.q,@zk?߾6"H]ʈ48۝ܐfnf/!N+)['ί7ѧ4?i,TRݱcU7'JpTw 'JupT# 'Ju@:oWiz3 xP:#3̧]e[Ra@ϑvq&~{IaalLf VjZ<ts\G nM]ju׊K~ixfu^\Vا%@k: vl׌c?,z0# twDAݩ` $`uO`,CpikY8ė&#~Zmy? &g&z )ic"MsVd8#gd ژWc2&UgժIXzJݟ|CKӨԌa>PvH#!#`kXJ8ǥ ^D?FM脋N݅ss_5gc{i`Hqm- \I'>o*iBri ЮzoeM}f:7DAw{r_s8??v:[N/|ǩo濬3^66tcN:6KYT*r Y*si۩&:J{*MQKt mڽRJn8`:wyxйsW,wwsWsW,wwsWsW,w倻ҹ˖r]e]9.wy.p:w> endobj 578 0 obj << /Type /ObjStm /N 9 /First 72 /Length 428 /Filter /FlateDecode >> stream x}]k06Mb>R'v5z!6R8{uM$ʥLp\@S@"'X(jH ʁĄƂ$̇LFI'>u{3Ľt- #1>J_r$"L=hL pM ۫[K*{^qlZ*iY9lT8M}_l1ekʻϼg+]cp`~ef} i ] /Length 1660 /Filter /FlateDecode >> stream xu|E`Fwc0ʱ1jFP B,AT $ TD߯wA8J-O G)AR Y-ui! M);DzQ БrAnD]*<:SB)nT Bw T ]CE(0 וR1(L%S*%.JAi t @? c⡲PѱPy'tY*$~VPł ߭P C 1P jCxB= !4B3 4̏ ͙8㿎:FsLU҂ Qh 9 dA{>.~-(#ܟT 8,75;;Gԅ,hr: ql]v %yo*- |غH :㈺_IpHt&T)zPК:]*.zg ϯ"WW)8m15.8n+hAz!PV_ o)F4#b51q(~*MՄd2X-SbR5T"3}鑘@SSgiWk *(~Vt(ZfD(R8V~e(]++_kGnwvWݬi#:ރk?N l٠𬎲ep1$?7 a36\F#c@F)7hB7FƖ`|P9vyhRxҋ&|--u`N78obb2L8V"[F'1Go ǷkjI/<7YgE -z;Lr+ڦm;vp5vwW9k{ߋwI_C\ yD9ю[imvNʏ"$ <8}woV}؄ʲwJ!a@8D](e endstream endobj startxref 124169 %%EOF xts/inst/doc/xts.pdf0000644000176200001440000055711314552546765014162 0ustar liggesusers%PDF-1.5 % 89 0 obj << /Length 1832 /Filter /FlateDecode >> stream xYK6W@-4MH l64Rf73$[olZKpfyFFϟ.`KgJFn"6.\,ebgMV.[,e^/XUyV/]r2иm6+@|:#[a.=iM–&$~WZC,:9F"_}J6|*ԬvX*-1 >9+x9"̼q7yhKkd ٩bZk+]P:Ł)1w>,[V-̇NO0[s,#Wi7r7\mٿ,n̥ČaĀ\J6Gtٮ0y fvC`8ٱ̎7D=r\g~TV,@Y8^Ȅh:dMuGxz0ya7Pyό!΄I|q/C0<|NO3_F"7?PzHS8Jv=jj].X)cfNaOʯZ,2JJ c0pA۳P> .jEgݹM$o )ՑJ/T`8!,Vv5ba n1f A]uv-wD ~kH_7PMBoش]4 H5 c,o'3x,͕U5=o.ߩ}MB85 fLwk|x6s'*12" *|z@A1$elmIr^lw`Q 3!Аln 6M In&uMJ_R _JHJr4u4,%J.]JY~HB:x 52@ w͋eIȷͺ۲jVzNYcuf& 3K|e ;aĐ f3P@ 9\up*l%ky~}´H6w3|YF&p<S^^Mw=SrbB%|U 6?;h YbgPq2@TkcDCġs+s}( Ը CjB ea#8DPV=G/~:|gT9.wmW"?!X)'VePwisG$YV͸)iljicE=|a( endstream endobj 107 0 obj << /Length 3396 /Filter /FlateDecode >> stream xڍZIsW6T! p;NP8N<+,|}Iq@4 W5g׬-EN80m/[^ϔ'b2#w$A}?9Kt#f|T ;"Rf!;V.Ly4s~b_~/=`2uv~h:^_]";D4jwQFaw7dzN- .d 5(,ؗS*7r¾әW[kXY[.Jeh}LS\ י 3dz{[t^$C+JQ\}#c8$t@ LR@H)a`k`yVI 69r`ϋٸҺ$^d wMN3iym,9$"WYisIdyН+!f6y_%<5NU zU(hx80 )Ǯ_.t( by9.SXfיz^r5-0}Iḧx*^T#"'S`%߈[J/wQʌ o>764|{0e=V3lxIbTGapK>On?ѕ, Q2ۧ|N> stream xڅRMo WpҚa}Ԯg=PN}!dRO<̼7@QsG=U\nXՐqdMFSax)JM̒Qnh q9kw@Z4)9zNuu_w WIjS @uѐe)Jӧ9% T2FZζIƐ$1ȋ5qJ{P993?Zwj?.HSkOmd1L-I'W1fDV'#"Qh>RLE4Aڴ9̜6 |h.1+M:J8e>ˢMWR#0WGLD(J)8t7n#] endstream endobj 117 0 obj << /Length 2632 /Filter /FlateDecode >> stream xڍY[sۺ~ϯۡf" @۞vi:gNg>$d1H$c;{u1E ^݅*[M&nFI)nNҮʢJs]n|Q*˒۽_otY&zu߭wwتiVY86yoWt[%NY\VY{:asMau 4Eܵ#{bFfVʳCT^yqp]qGɯ1mׇ#LSc)n^xFXu7g#y 6h/~yJ|Y9+@0ˢ~QvܲGYl0L!RH`H3 N3pxOerY*cp |Q/Ԃ84G9 TM7zT"p5[Ӎ%G HTȌQvͥq,vwCb &:68-*hz:MTÌQQhd(R|bg6䜤mdN^-{)~2+۸MnP+Ծle՜< <"ͯB_uߵ߈J3 8d v7ȾHW$L{2Upq5m[ U4.SkqqL"Qֲw&[=t\cfKʯmX%aj\'H^* +L%ᗒǮ?/r?H=hJwB,Φ. I_}@6x `?;X${A\1V%;z.wD3ijT@ (~_=`$ 2c@T r1"&'CܠC4v%t8=ϛ~t?dJU,F։uq@d֎E~7_Uڒbe;1[Z9@qJLJf{/pNG;aሌNds;NJ*0⭭JUvh[at\ʁOmĂPy9~p[ʜG>}"| 5/S_dZ0~8u_|bLU i8:­> stream xmRKs Wp+Dxױԝ5%=("}VF_vC; [n+riQh2TH=S({Hp ƾ-C~9D|Ƙ!=B4PBÁաChOݶ՟ v_]2TUBV5/fvB%)5Srd;7/%s}?2<ڬR56L?Tnk-5֮K8IU+)} "> r! :f´!N>|0%%\_wDp|HR-ya¬9Źk#\bc]Fg`j¹뀿E²v]f1*iPZ 8; endstream endobj 131 0 obj << /Length 1931 /Filter /FlateDecode >> stream xڕXYsF~`XZ0+L$QIF (bM ZV~a~!03=}~}zuҫ_hy~}"2rQbW׻qNIJTYۄhU&tIrOp=^cD;2Dw8$&\M>4֪4tMhcｼU?SՖ[^ >uºQ&X3} ؘW02iϦߓsiKuߘ#Ϗ:J~/zc mWI ӨK!fs"ps6&Kl vDx4)^KDhE'\$?ՖDz@ʽ ( QR=*>N,@gޡ)$ԝi{J;R|^fvmsk܈W?2c xysU2gSwXOڀ$7J*V].SS68GԾ\6U͟ 4'G64Do9 I`c 0AopZLJ(ؕ`M O*;6^:ӑ#LA.EQr9iݩ.aXWIy,%aR|@qp0~`iEC=H\9'6 }ŢRD.hDie'ġq4Z*Hv CHLSY[" ^gz< x^#+ANS˞$SgVmU:BFU ~~pږ?&?KC}[%\v?}''r[idYrݘ4MF܍jٜKZTaڻǨ`0qqC9!!foxTerK3ޖ\#L̹{F7Zk^0i[*T;!| " 8ɓ3M'F"e+U}dX0cCw&S/lUStG0WTeqqdlߴ }'m RQ,JִzIQN7Z5RcFRjk?>f\OL3jˇ/|cҠYr\Y '0JЛ-TWCC988𲀰p:֝ \6?T fdޖoӘc6!pE^*ֿ\_Ϟ}GΣ{Œ T; y0ޔ8#WY;TdA6SO]8\q}T\$Eمo_s endstream endobj 139 0 obj << /Length 1987 /Filter /FlateDecode >> stream xڭn_11,Ѵn6q Z?PdxTȦ%קʔ`2Gu'f#7y%OlݦE~YoR m\%i<}x͗Zl'vtl0^;#P6m޼~FIa])% t*CvJʤ냧W*k|cw`> /q叇nk޷de.LJY50"s5lYB1L9{mw]60g2_|\|%#nwuqfEf6kQ;Y&{ Lvv P i|B@,܇=·xsݙl &O#C|~˒oqZIxK! a^4kb vp FyҺr<d\F:9 ҋ&%m]]-K#>3keQ(l75(woxh!E3!Dj$-)`I FGX+s,4wM @ZKq|&5mY 8hs@0џv6Jdk MժJч. Q3dhKN q;r$['d/-L όIʺƨ#}PpkF!v.9+I RJod]YA=~BׯbeH3 \]U]K¹ـISKڙT%0aIsnt!\E:Lj0P\sa 3slh-CE1 + 5O+%zw͜?Щ㿅䇹TBZFv\P:dEjYCv!rلzG`!aPd+mb;5HƷo*ڜUNZn̴xϘpbPY?p̕hP-:uL4^ZV#ԬrNh=W+.V@Vjک\+9+ U,Q<ִZy͒a|KS≬y>e]UҀ1dVGtcBf0wY738y)Ihb7;@ ;Z9Yl(r endstream endobj 146 0 obj << /Length 2239 /Filter /FlateDecode >> stream xڵXK W-*b?IꐪD#AVz=;9hw}*vR9h4~&o߼V]Vq'J2}~~wb#"OTۓDzѹj5PEtpw5ϕ/ŔGi4GR GRA R4Tx =AIqM ^N:e 4X<ɵ 0Dr]Аtf~Ieq0?o\$RN)b+kv>֠{W84^qC6oJ*jV**u&EZu(8Aj#ghAAe#4t0P9jݹޗlFuqՔ /dx!C\ :=;.Ĕ~pU6虮5R*zھZq.>xrܡis0c_[:Y^G_OiC۔}n &v( $-숗jP̀2iעDl6r8Q*l 4 EV$> e^e"w80H*Wܫ_vSHa!N do& P!= n:9 @&ZRF!q8 |} D rfd+@3ܫqgrQXѺOx'<|C5ʕ̌}}nSE;H&-a$}n7p-'d"'҂@Zm}㥮yhq\tbMFb-u5X{ |HU2;L-[K`"z7$.Ǭh@ƨ˅`O,͖;v2H4͸In)4^4K]RwL{Ud 2lT_JfR4xTp&klՔ[JnG87Qu@KM-n^ot.=(N9Yl@A“$٪2ou! eb?0OsbIsSzY(Z2a!AlL ~7= aPBc+48Ku8ǒӠIqs!#A\ǙTKtBmg@5V7 *./{jgJnٵuLlIZH@][Fk !"ҳtX0#{W ewf,9',> stream xڽXY~_ؗKl'7 FQsUf%δ}X9<uf᛿ͻo~Ŧ`fssJ1k,*6$mevP٦Jf$CMM&ɿֻ'|ۻaeh0כ~C=@Y]25dr]G4hBR' ?O\骧U6r#zZ'C}# GP[`>MIɉ6G|%X'gP +5q=lwn_k1V2U/8e+}/?bNI& 122 eңUެ@=}IcJ'']*"p3QxWdW%q0$hdmAE9=Ӈ#0h-S9(cRNtL 0`4nud*rL%@4BZpS)8O~hޑJlδrTɹMH d¸*l>0!8NƵX?[ZKq|;}]еY/ghgt%q2/g+tegL]㎬xݬ%gFXτr!\!W ݮЅbFĬUl9 VQ<\y]vjt-KO'b Ox`OIL>6<̘?0D;7ڕ VB 0R;D+R-y ђ-xr y磕|'ݬ 90bq?EtB7RI5!Xa<3wC"H[/ g]慢>bSErP7ށI|]ü(XKi|o UMq]鳟Djh."Iev*uu !9&lX]|^܇ *XG ҞJ*_ZG~@iH; (s x4sʸ +\mdRHys, rm3);9_־R@\}$S=o]Hۙmsn9ڑ-A!ЌYERH6 @i"r*w(G=Mq wDG չBMS@Ђv!,LvOUsTXT ysQQLvYiU@Po]{c0Wv(GO@_m@jhjm*~< ]RsKjS!5w|,GSIM* \ݛ&Z<w@]`2WWY|3%MK%o%ژe.ȺrcJ"1CY1۶?ͤw [CP$oi>D ~׮A~u"Q@ [A{ uS},cRW [q6D#% ˭defɹY]t'E1* NoHÔKܬ~ePdI]مۆUW @ ~@&T1֎o78,sreB-ѐRX0?~<-px!U> stream xڽn6=_bՒm- -] {hAQrZv#EΜmO$I8 Ǔح.O^\iPR \͖HXЁ,QMӟ"|po4PLXÌ=ק;}[(U2 Ɖ8ge&oհC[DI#7z ʸރ ej qWlO,Oq[w$Uwx_[/Esr.ղ;2;xy4f+@5xݩ!$3գnЛ9F]$wߠR>!b]Y]~]Frz |u$T,c{Lu52+#c,* &>$nє ZgCb,h2TeW"9F^IJS'3nVn U,b5=ArAxcҠ!0q>Og&7'ٱ#os֝S 53/~Bpߜ'>N^_`bͫ DU{fR;7qgxW<*"ǎ" o,Ҍq<@""`5DU5"W;ʥL 0h8c|^iɐ%bf珙ׇ%ub )s7ܻze#]]M~DQު9!q Hcav5}JJRڱb6Qp[;-n]VQxux@C~l3~:zmVRMpx@EHm!:4\ٷiц'7/$N]Xc&$|~}/2:\H[= mwHa%w8pn24z6faUUwo3+3*., kW@$AUEi=q0@RN'6pշѤ Ί ~A'O\!~oQUژF>I9bO_$1gBl$ -8yP:0Fup 9ֽqp4a]nD X9$ʗ (lq9W[)iy9XW( >`HRBSg)LJlKcgZ8z8CD-C(=%l}[[uuh[ )zr+"r7„ endstream endobj 155 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmpemv7MC/Rbuild1f89fcd504be0/xts/vignettes/xts-xtsplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 161 0 R /BBox [0 0 720 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 162 0 R>> /ExtGState << >>/ColorSpace << /sRGB 163 0 R >>>> /Length 3079 /Filter /FlateDecode >> stream xIWi!󰌍8H, /^m!o}c~ݗdX$fKۇ/>R1n>#tn~r +o-1gH}kR2=ۿ:S5n%TRVhe{q{^Ǽ}K|=e?ջ|՟ͷ԰pKooԚ>2ÜۏԪQoۻU=5|5逆դVHLPBV5"E4S%IP "0DI0#"hj%H*hj5DhJ L&hjftjr5%4S&&VPhJ4L&01D` I ƃJ(Z+4S&V] 4S%XM: XM:X0t@ r^ɤ &Vf@$XM:Vk2E+$Vf@L"P&VC3U:`bb5Ek;ǃI4EtjAnL:`bb5Ekft@j„VFt@j„UpeI*hXM:@$2适դFP6ʤ*&V&4S%%ab5ZaVD:`6$XM:V XM"@ դnL:`bb5@<AnL:`ab5Ekft@j I(ZaeI ƃJ(ZaeIzL(XM:``b5E+lL:bb5"U"@ъ*P1tIPBb5逊դ&nL"@ դMtmIZj 'M:`bb5E+$Vh2逅դ~jxܯKD\$^p=]p%<}ϼu[p֫||-Wno,ޡ,^DÉH+bׯh=}-jg\/FΠOo̿_@;^/Bo Oc?PiZ ?Gk^XvֺX5Z }a5:Uj@5x̿0&N{ĕ52a_KH^?b:g0 E<;ag(\ZU M62)J҇1za>^->puXj*FO mO_5?["Wf6_yX~m:ҋtĥK k#.- G\#q}P3fG\:dCAG\9(8H\8nG\X9r-#@<ed2 'x#V=eg^oR4ngxh'z5&_]0k0VM%m7w.ի-qvƯҫ+9Ovra6RWQr<561kvx²0l7K؋+C\$a1%ro$wCFr[Ͷ4L_)·`-W<2]F% 8rYO0FVi?&D6 C޵5iھMvgޤȴ~8_R'yO3-e< ,{zy}^8WА k{,shzc<߯Y@ TqRfǭQ7hqØٙo~SYhyUy> hEؒBhJшET^*7JH&bD \V1C #p_暽"'>"4%Ik@K >5dA4< p)VG6U\/2k!!35ED@#S6"Z6?;2@,tL3\t#'*Goވ_b|.^=fb%dǿI)/s|Y%_|Og`'_%'en7:[Zk|(uk uU돾`Gz۠XAmXvn`_L1_k߷=0m5k߬>nLoۢ:5]vs5oԱVz n^ą7͛ꏇL|Fw#6l8_dr1P&?ĵBN7#8XHO 9\󑉻e=ʂBW [*|UTC%T^b%V^b%V^b%V^b%V^nFK(:>/EeacZkGdv 8Uh2唗.9ؽ7Dž'W8h[Q# c3+v M/]SPòk,v ^u4n^HyI6+gd.L/1~'Q[ fd%Pf0kml+9/=8ރ{'L4[1{StpqsGa9oۮFkh46ҵVN:t8ڟӒ4Z`6L17dCz&|=xuZ+m&TJ:nլǓ b5qY<,24[S[8|+38At endstream endobj 166 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 170 0 obj << /Length 1767 /Filter /FlateDecode >> stream xXYs6~Ф:B<ЙmNtR?dx:I)PłMzµ\,: I2+Yr=8gyV̲4g1OgU!Lw~sGfZliu}x:HJH&4:"\`ȉ" ;.Z{%-n Ev Y5X`qR"=&eq\6f`7F/@(+28@$a2Fb;a ~&,8˲Ō0_#,LYE D;W5 '.\ m7ת\,x{Iws4z譝m Z .ҽ }Q$JPI?:63}bheaD{OȒ1n񂇃P,z,I˱}_ +A0h}4^f/> ^4uSyړVe{NrEs_ az%Yi_/W܍%^W8,7/G>I^q'l7؍QEM[ $[BT7GpY} f<}0~P|!LȯW6[Ϳ4xo>g`=6V}4 VCȹG*`#UN;kwhe>o+aVS=@Y4*[0c+`8< i Q,4qZ͚~t!߬%~7Fdod+ )g uصV@#cX!Kۭ87 Ts4hۡxkϷBBo i{t?CteS4HsgCΓ@YZcv# N@+R(ye">f=~ A[Tqm%l'.b>ut?/#n̮Z!A( JfJQjh.L9*JqDh$~jV{ N?#܋]KܲTaN h\| ɑ.*\ƒ[@qKRUI1pVPhxhfwfWqe-KI/yrx* !l{|-RH_&>p6Jk`J-guIldܣv_σz{ϊ)O|V)x/X&'و܆]uR)N/+ Nz]YFTz>n=$ %WǝܩRaL7&yO+|"B=9}> stream xڭˎ6잯xǒWhѦHSwnI[ƏKvHZ`(oRnl~d~x?nDIn(em4> ='!x8Y@yt^տھGӣ؏eJ=1l¸s;a#\D|[{Keq+Sҙcd♞Цp!!qE~)_QȈa' 2U{%Bx(2<(5bGov2 Ϣ=JVtd"mߗICK X4soUxI`3A,ɂPfwн)h~l۝V1L*d+{'ZsL{q3åkLap (:,Ska I{vr>Q Nl@ v2 Hd$f2p"X0ܩԆye|$$3tu|덖q<#$rv9ՇѕGD^=.֬1zvh aSDo?ΐ۲>WTi=t|r5+ qtTCe̝w%$q +T(ԫV8$-PBS;_*VJffD)-gNgYz`aN$|h#D$&J@K *'DyÎѶ}Dx%GiՃA"|{\A`,XVDCi Cer{0c U~BTy֊3"iхO|>Ε&I Q_NE,,/kCn! 5X'D5ߜWu{ƾiqnY#J͜x?j)PVn2Dl<|sps$^z[Lg7'3UIl;ԗRE_KlxmT@$ cp4 GF?  ;[ƁnCJ,b(!_6G>  0`oCI؍=큨R@l=o|D?N[}pc{&XYZպtw08W;8/x:] y8_4s]_Ls}1䠛jK`A۱cn;5BJ?.L?.4&Eҋ]Q$"aEwc"0%X ^zS_^ښD8i§kEeBkgQHHǮǃ8[-P!e񢛡n=8%Bi Yu#ӵDd қ1k"S`*q>Weml߈*SA]3 endstream endobj 181 0 obj << /Length 1770 /Filter /FlateDecode >> stream xXK6W2)|S<@mizHBkӶ8_)?V!583fg/^)5s3nV3.eaM93Br6pfj~z "".vG`Lnri4]X-h͒[ 9oQ&/-_4˦Eۅ'P89$ xy( P%HT*Cؠ2Gp4;ѕ+J`0  rZ.Dl}$]Ҷ.qmqgшCL.Q1}CV[PӹRlqRaow>C5P/@+u22ԻnGpΥ@E3{f:q锊8FlwQBz>j4¹8F-8Pݢ8[%~aނX-eNfd[;DaS K~}rʷW09 鼡L\_nsn<]$ c3U՘B+ aEJmʼ0OeCn.R cv@HR~HBZ8Oۜ[[Xwt:c0f r.J'BHl@#W) Sp/6SVe&ZHdYaU$ODp L.]d29?ꄦCE[G.)^2&y?>U6U7un&DX ,okHC K-\*@ }T"Rb7W[ů#lכ|*3 M!ڶG mi)ќU2O)&Iq7LGrMLH%C lYNkXc-B찵 h.Tם_SwOwS>>>!f\VrpCSmAt!X;b[-o#N./αkت^lX[_be!q9UFM&rT)zhA]O>`."c=ʎJ[ajs6ۀu&CBvs";0+%Gt pqfVX膞}C4e-e Wѧ(8~ŃS}/;wJVP&VB$?*wm!CjC^t̴;^GRZLm [~y/n endstream endobj 189 0 obj << /Length 1489 /Filter /FlateDecode >> stream xXM6WE֊HtH4Ͷ ڤ Z EJe %['̛!d]$%aT.8W\-n6 %q&J )Ꮗ-W,l\I.G v7D -__U8tfJu(X12|c $zJYG2VB-WB4JX+  @Cs.aK!Sܗ Xp`,g^5:ٜ_L;g(c d2QyP#<u's^. 34 ƹqf[MUBz5}בl[x]O^p)܋?e~Z:|Sh)UG 0͝"s _1k&yţ3T~Kd$Q$z$َbS` V7>VCBpEH>0)}`x9ƴ#|8C MLt⼧+gZ-ྏSN`dg:4 endstream endobj 194 0 obj << /Length 513 /Filter /FlateDecode >> stream xڝOs0:LP+LiϾer`05xRWCi'駧}+ zu}94j2(i2%u+xH?Xf,WҰ ;:E!L& fH3H6VRJ,1C{Cc@^eRLDi+jc.Wms}MEAq0"u)PI^e[6Y 'hͥ_|ڝ6Ԇ;c_V\E^SHv$*y8۴O> MSUVFV凶8iG "&e~pD[E^..%(\u(/"Ly耭.5T1XJ |>iHM=4#afߖUt{7]鐑_H }(W鹿zZZYe,5cXlJ9+rNf>4]LťFILlYʹ\C@/%}\_ endstream endobj 198 0 obj << /Length 2271 /Filter /FlateDecode >> stream xڍۮ_p~)- q`1E2\\P;HٹϬil*}ě0$6M~,(N7/^݅ax?mzn;Ӝ8˽G3 FIG\CDQ)2 . ",gSkpv@E֖j mzj_klvmQdW"?KsDZEx{ClCo_?#Yz e{w~̀ɰ-Ǿ04Z6}`<4尒=f<U Jj{'FLVI*<,M3L^>fX! 4|*Cf؎]ǹDhaٸ;t6iQT;h'$@¦=Fy|H`[-R?Z^sxnYQ'a֐g5ql* 5wa*b;T.pETńԏ1b? r=, ?ϧ2KO(waDžxXB!p!&QEBT{A gD!םVJ6&D8vH%VA1$ :+F7W`JQ1c1Ǝ:i ӎQaRt FĶR&w(hL8̐'. Tnahfh^NKY(+X5FCo <][sjl2h.B$_ ڦ\$,Y V}T/76A֡-(GTdw³RtqIKK]HڥeDp,G,\H0e ExvM VmnG7n^HsE1O@x9$߸.pL*J7ԆrM6mi98U *ll2u5-T= !QQz(C&⋗m3}ד&iilLy^va{@hb1h_%EbxWW8\I`6%A|(l[QrށBNhlrs@*nIC8o?S$=:4݊%1F褡+c\<`#aJL](J:Lugb1BF _hͿ$B. 3.<=S Cuh;76Ѥ5oG[(<Ъ4BŷLWl MKb^#wzs=nbzٟI\T&$b*D"EZˉAx J#Uεt+0.XuÎnHOfo^f0mO4eW2XC(K@CDmskxӰca $#|^Q#)E;  Еr5 - l4ʟPS62kh) Өnp6Zk-nH'pQd֬$Uk,F)GhTt+4GL&.)3|a $@יdY oр2ċbŜJ\+kxeU o9n>ɰtb`UҼ]oĥo*N뒜'fwm0U6Ry y !9%FC Ҏ~/˜vw(kLxzT? I%|Vp'<(Ҿo'ujI78 M&P#ܦ=~4jog%lA*4\G `~toڃ%3&Њg?it#ϴNud} ?$ytz#E0yr/|.lY}TW_3'5Y Z'v v"ה}b!㯔 yɴ/Y_:+2;s#cOzgg (x)* G2̾bg7bFؖ]i10[-', endstream endobj 202 0 obj << /Length 2404 /Filter /FlateDecode >> stream xڍYm _;E/F\ m"E`IÜ4F+mrw|HJ]k9p8C>yㅧ߿޾mor7Ods{M<ĩ|r~x7?_A|w#/k:Ϸ#0~T_C6>|oqܛ?>?/x:|GB}v@S׮ >w"G컬m:31,ZX7fgFcoDH_-%cvq;(Rl%ﻢ꯷ 2?N"G; hKJĉq{qhr/.ncյN~lo"7"ҏdBJ}צ1 !]^џǫ uY mTm-m^DQܒ  u$!#Y;! `rXu4B+ dۆBsLw-R3i/~ 㘃&-9"NP `囤5={v fV6d9R6vZQ;=ENSʘ'|ih΃NʲL'm{"7Lb7=*ȚcUӝ%Y02$ω#hMYl5$&ڮťb70zDt}մii`4}M#)aZX܁PV3uD)v>+ΓB%el?J,Ochb:1 a3(]2r{HͦbIxJ|O)N/)aM\l!Iw흹C,VrkwNFFKSȥƙw{eyA:+_ :3gg40-s$J$(EnT J3Q.MЪyjgoL/Hj|mm]U0Lʑv%c3<TFrUCˇ؃\LGLn z ,.˘˫qB\"N*<r*D)ЋT5'` -"oJEdx- I14\A/3I1ӕ2S`pg &yUR9v\1VP1 n>]-~" ߩ9Q!ImWP/7% =f`"'58f#}i5Q;S V9쾆bTNFcfګi֎~SO38 u"-$*/cMIRhiPV*q?TʼnIt+cfVal8ӎWX-OxR\#/% 5\1FI_Ic5ӏEAfqQ ؏1|H~RWԷo#?!W*NsU'4PłMUGp&B:k͊Q'I. N/gRٳʾ(WBGQX$r#?>{F7 0z lڙFSK)fe M = SN0*L/ʮfO]5 d.;i̍7*d5Q7Q,,!8X{t%JYV"JȕB"z|hKWmgDzTbԩ`i}Ҧfͽ, Ȳh`Bƪ̤ljTy5((WwS^9/0vzI{WZ$oiLLx7\QAnvv#YE_ - -V[S5͵ `F"<_5|+Kcci|{d*6_o8̸0po>:J`4h=azKh^ܛ~wRE%ǑfW{T9~6οPq`DRYH8^t1s׃w63vd~~<{yo~RG7gT !-G)>Ie,H 8OOm|癔A~ OVjH3V"+z "ETdf_MS2eX//S$rq :k񿧻*jd8JrT TtF ^aR"K녟'@}HC5rQ[S*F v?a,M^ }'>P()Y|g+KR1d}Qd!=CgY?=ys_ˈ endstream endobj 206 0 obj << /Length 2089 /Filter /FlateDecode >> stream xڍXK Wjİ_|vSNr'$6q"dsg&~"5x~vR~ßN4FO;Tg.3y"=ֻu"G!ipTE?4OMg[}q咽LU.,weRf2Cc<"QEN=j2MɿSIt|w r*zލ rh/tD;00z8"'`W'!Xo} `64%M ~Р>/#M8 ޟ̶W8l[MEmG!v5]Ww_Ked~Ȣ^E贈4}4XbIz3ZюXp;]^FMt)4{b轕*d[lRHjF|Ifħ78{`9X=zG> [~3Yb}uN[uHޘ[{f-U@>{2()! kt?u*jv ~N!o'ˤ( 44Zm[PIyӤߎ9EWrWwܞ$|>n%(ktdxzK &x}F8O u#K#!eF恡_utm;YF^(c j^K(n?b*9k<7n`.a ,*P w4h1p.;4g?+t%+>ĪE ۣeMEQ:*\3Vj!rXa3HX*j.OB{eoE8Ja]5Z}o6sA >+,_ ;<藄I+Er.@ix tmn1KNt t\"IWn,bNudža8يq)0K=7`[67;d:JrhZti6"lHeZunGU؜ ˵^J@+'e&ʶ -P95"7Zl/6+_v]}nSFh)$w$6 :b\qn%̞۲@ff J2Q7J)`Of@!_WXDpa^͌}쑋$-gml+=r>GmG3'ߴ##,-v .G0o_3l\BܞQA.d YNCt7m#> stream xڽXYoF~,`N"vlF́@HCA Ȗ aYrL%z˰Y]]]W'wy~}o#ӑ2Qnv&.SxwUx:W0vC|$^VHoޏz\I`Ze:c/'J<:Vi+X;׍%*1cԫ[|fxgGYu7mf̹@M"EH6m}^Y4ʳ,DP|~Ty/l~T Q 5i`ђwE[G|,~=X/<ҙq.ێR8ϱ*XCn (WiV,ypi= G/"xpZxVS9]$}h6مTT?X,i 0]}eS ܈7@BЃ?P[D4ஓ@gXa5Z,0,85tG -eˮF%xaxJ nUV;E-wD\9H g> stream xXYoF~ϯ[kIŊ\[lx{Pje~ybɳ~JTrxJhr`u>Xߝl7tiړض,o;>/ytO>] j8* R9?;#Rat{Sek~g'Ǫ团n͚l59yF Q#O[$;ʉvm+y߹R^KmDw]O=׺2t ΋;Zx4|aZݣC~SnPNZ% N`3["k(ҝuY{ngwdrdlRnd \G Iޠd'fq/ZvW*ʷ}gZ,u7,'95?9Q[/mT/68@h 몸> =O]Ϸf%w #'Yޘcnpi8A_%?WN^8DswL`/Tn t,2[-_W)} ܇˾B'⼮(j#<Bܘo*z1\AQe$X0RI 7f``n |DβT&L\֘ g!7}vB(fńͱA|H͍.a!d8rY7)og%ȹyani_Xn3hd@Y4͘p^K %֋W;NXLHwrX.'ˎ0'1`@qbŒTo0a˹m2bƒ6gWMMgv% +&{1ˆ­s%$`E" *-,!")X/ %ғdjL)aPaC4LQ ?P"~+JƏ, k鬸;֋e 0O@'|;`ptA}3i%*NyPS:{;l}C{90;9>)%q@<.##8"[5DЯiLJp#ޘn82rDZ|eM"z¥_ aR;8z Xm^ۯ+4 a L&r8s wQKȹY8bvG|Bn/aٚi(`BHdhݎsqЙ- #T'Ԏf[,q"O55PWc?^ѤRE{Y#:8SyU8/-L0jI5a47) C DP>t2![iswX /iz`qC~ls O'C>{ pMsp;d#|:^HRXj5y|i输W3@AZC'TAS6g:EN/iG 3xLm7\zU;QLjf~BuYKLJ+ß:=eዃ?2 'u𝊀[3gc@oxM3FCA.{Rgp_1(|!4 pLcG.0IK;LQNP F?I? &+ bd!/ MWy[xğFp9R^> 43iR ɚ0qԠں`wj(PhHsמ|_ endstream endobj 219 0 obj << /Length 1718 /Filter /FlateDecode >> stream xڍWKs8 WHDHQG>:3ZV' cʶ |f޾R",RΖ0KYdٲݲQHn0XzcHVn^nuѠSs`™Eze*Uўm9kg 8Z:4b6OwH1إE{j;W%,^4Z6)7^u۪/IdnXCl2,<6rlM@f{|m轴ЮУi&;]4Zg ~g]~YӎV^u3:ڔxmmΓ+ahiyGoGiYUC@ǮxҒ3 λn`Ku{]SNt ?J {g)(Ƅ$ yd(!ʽRuuuq¬~EXa#SQ39bk3>JYKc'm\Z(f0KrZm qI^v=cRҬ\L .Ox4W7l$jlN̉ԈDV`D&4ӄkc' "תCv}pm;tUd{PȔf`ӖW)B\Fa^}k9(|UX%hӺ !kz7)p vt{3qƪcLC1qB!݂z|62 endstream endobj 222 0 obj << /Length 149 /Filter /FlateDecode >> stream x3135R0P0Bc3csCB.c46K$r9yr+p{E=}JJS ]  b<]00 @0?`d=0s@f d'n.WO@.sud endstream endobj 226 0 obj << /Length 119 /Filter /FlateDecode >> stream x313T0P02Q02W06U05RH1*24PA#STr.'~PKW4K)YKE!P EoB@ a'W $o&| endstream endobj 230 0 obj << /Length 199 /Filter /FlateDecode >> stream xڥ=@PL ȟ b&ZY+hxJ d)-bߛy63f%gtx0e5$ jOaj:*yAUlQtєg&̛}Nr 5r^ a2ʮ`i`r_zH&=| z)3WwFHH endstream endobj 231 0 obj << /Length 203 /Filter /FlateDecode >> stream xu1@EPLL 1D+ c&jQ8%gdB-^6gߑ;dO\q~ƨ4 Py*^r; SrPEqbtLR~3&0 > stream xU 0ES:ޢI N&O'8:knh@}7D%YgXnE68])$$ƒ~ܟv1ɂ1GG xos*!~Zo(k B" Pq>.۶{xcA+M;= endstream endobj 233 0 obj << /Length 187 /Filter /FlateDecode >> stream xU @ O Yxw8jotr'utPQ5I-$f2c-Z)+GZv*C@Hx=Π9sT/Ԩ"kF㇠ZFQ"7!\LŮ{kw; #e%(𮈻i^/aTtY!)y@,=l M>k endstream endobj 234 0 obj << /Length 167 /Filter /FlateDecode >> stream x313T0P04S5W05P0PH1*26(Bs<=\ %E\N \. ц \. 30߀JNa!?#I0#;xI#> stream xu1A50]c&k%P)DRAhQA;C_ V:F:i]yYm)5КԸI T:"$a"X B$֞?!#rljtjCsehx. MO {}RmU@#C3zT endstream endobj 236 0 obj << /Length 107 /Filter /FlateDecode >> stream x313T0P0QеP0P5RH1*26 (A$s<≠=}JJS ]  b<]P$ 0,) endstream endobj 237 0 obj << /Length 154 /Filter /FlateDecode >> stream x313T0P04f F )\\@ IrW0 s{*r;8+r(D*ry(01030o`7"b?2E`V`0#H'W ^F endstream endobj 238 0 obj << /Length 151 /Filter /FlateDecode >> stream x313T0P0W0S01U01QH1*26([%s<͹=\ %E\N \. ц \. | @ v:QAA=N ?@J@#`p`\z> stream x=1 @ER~- g`#8RK EJ4RZ(ޑ'̨i> stream x313T0P04F )\\@$lIr p{IO_T.}g E!'E@!ncr e endstream endobj 241 0 obj << /Length 179 /Filter /FlateDecode >> stream x313T0P0Q5W0P0PH1*21 (Bds<L=\ %E\N \. ц \. @xD2?@,&=`C" ?ƏadjƎa݄lMI$b6LrzrrШA endstream endobj 242 0 obj << /Length 124 /Filter /FlateDecode >> stream x313T0P04 f )\\@ IrW04 s{*r;8+r(D*ry(0|`??0 ? v'W a* endstream endobj 243 0 obj << /Length 118 /Filter /FlateDecode >> stream x313T0P0S04S01S06QH1*2 (Z@ds<-=\ %E\N \. ц \. c$! b\\\ϊ> endstream endobj 244 0 obj << /Length 102 /Filter /FlateDecode >> stream x313T0P0"3#CCB.#)T&9ɓK?\ȒKCKW4K)YKE!P E >'W $ endstream endobj 245 0 obj << /Length 137 /Filter /FlateDecode >> stream x313T0P04S02W01V05RH1*22(Bs≮=\ %E\N \. ц \. QqC=C=2p\   \\\8 endstream endobj 246 0 obj << /Length 205 /Filter /FlateDecode >> stream xmj@_<s>QiZ &z(BNM9$7GG$f+`f`'TE‡~(=iDEI1E2HQ]%0 T Qm} WG?pj26N`Ԟ}}gvjPhCLQmQ +I.I7y-q endstream endobj 247 0 obj << /Length 188 /Filter /FlateDecode >> stream xU=@`6$p.?`# b&ZY+h+L9 Gذ nKfQ!!^CUdx[a> stream xmбn@ 1DG@ CT*CdPeJ;vhծGQxFkDd>;zWMrMMف5eJYƿ?mvϬ ΏToHN [`CZ,{ê3VZw LRD%ڻ{F:lZY> stream xuн0k#xO `D`qRG(}FBЄĤ~pE.-K =zh.wStlytGN_NgL\kZZo-T c ښ[ۺ8Rf_yOwy_6|pdmA&:QV&ҘP$> stream xu @\z'H  ԩCtEh>уhkeͰ;Sr#&ttBpvd31[%OюWtOh9qh璳8"hre)Q5VzV \4 0i:ul3%Rk-Le00JKE|}xB endstream endobj 251 0 obj << /Length 186 /Filter /FlateDecode >> stream x}1@!$pBBEHaRK .G(.ZHI%ψ$ɧ)) EQgLs$"ܢvKs. yF R 0RG5X-؝X͠NPSϐnilbEO&4>=VgWX(9nn endstream endobj 252 0 obj << /Length 156 /Filter /FlateDecode >> stream x313T0P0b3SCCB.c I$r9yr+[p{E=}JJS|hCX.O0c? &p`Q"p@#`p`2QpOar IVR endstream endobj 253 0 obj << /Length 163 /Filter /FlateDecode >> stream x313T0P0bcSCCB.c HrW0r{*r;8+. ц \. 001 `LAȃ=`Aԃ:\?DԡQ?Q \\\[ endstream endobj 254 0 obj << /Length 221 /Filter /FlateDecode >> stream xmAJ@tx9B FSjtB\U.jir(sn }|2)$9?J\ze\)7oϔ-o/Yr>RbGx+$qP-T 8a Hڔ@\fgm{`%NGPik,F=pk0jluo-9m骢;[| endstream endobj 255 0 obj << /Length 200 /Filter /FlateDecode >> stream xu1@![L 肰!V$&ZY+h m(ذ.1мL4'bN%4 )$ft QbÀD4l ;+#/t=ȳ͂B9C X> stream x}ν 0+['SV8sh}>B.E$$q4MS;Q)+!׾28^0+Q.zŚl s ,5yofJNѭ>THA-I?6*<+1vL{Ԣyˡj endstream endobj 257 0 obj << /Length 244 /Filter /FlateDecode >> stream xm1N048IUeHZ()XA 8WDAr)5cHœ5\+.U͵CT2,.[ҷ\/eL#93\SaXw>:@~^M:_6;~qLǠVrﻘJX&{ب#Izc&4~g'.zw'ʗ EJsY#袥} endstream endobj 258 0 obj << /Length 245 /Filter /FlateDecode >> stream xm1JPYR |s}!` A+ RK Eʗ^a2Œ񟉋6̼yT尒x"p,\@_فs/*g. )&LOPvY`n ,{OěMx[l)zi&$vX?zΏE7 }t endstream endobj 259 0 obj << /Length 163 /Filter /FlateDecode >> stream x313T0PaS 2TH1*21PA $ɥ`bU()*Mw pV]  b<]HG#13acFT0ca``?p`L> stream xm= @irYV ),J--mM8mR,dgbF)MidPaly&T'͞ Zh = vA͒#Kv07}> stream xmϽj@ aySQ W-8UWT+Sq׺>yB[̬ ؏aT[ʨW>P13gJugbz0_^sްmλK= lhBNb&Yb‚MzvV jDmWNW_}5jio/*e>rƋsOY"W΀g=@r endstream endobj 262 0 obj << /Length 197 /Filter /FlateDecode >> stream xU; @? ` A+ RK E[7GQr)h1/t)ZEyɗϴOC-*2gd6:%Smx],vKȬqzjHHHC,10\qEqRc,S4EB訵H<,l)o e@)]X!uE{/^q endstream endobj 263 0 obj << /Length 212 /Filter /FlateDecode >> stream xuϱJ@_RG> stream xڕ1 P q(dGx9OA ZN⤎m֣xҘ!$!'3N*Φ|INY>-KNɗ[~>^W݊SSNNT D'Ҡi!4y;쑷Gwp{cjCe s]ؗʞZ."US9©-KI endstream endobj 265 0 obj << /Length 218 /Filter /FlateDecode >> stream xeαJA b > ]vj<-,J--mo||ybCBdy-j /;~2xxD-+j.KtoOԬY:ni0s #VH|ěFo;s+lq΅Ƕd,6ɺY'=alp +%D7p endstream endobj 266 0 obj << /Length 196 /Filter /FlateDecode >> stream xm= @'X#MXXSZYZZ(m#Xo[fa5B&x#/~,+E³N|n-f-nKn!R7 !Hꇨ+U4jdcޑM-孍@l_ "j~' f&74.WHe4A o \s` endstream endobj 267 0 obj << /Length 181 /Filter /FlateDecode >> stream xuα 0+ zO`RL'V08iGE7}4бC1:n83d3dftJFq> stream xmαN02Xŏ{H.X*E"L0"5)oG1o`ŃsaA t7;/%KGvA)N v=4GOYScs W,6+"< .L)'rf;GpaF]1P.;a?2yWL ǹG9^jo.G82TJ="b> stream x}1 @49IH,-,J--mMoL2LvY~ Gc 0G8 q bɁD9쎐y Y|=,9 ܂IѱË_ꪽ^cf8y/>_[;bPsfm]vҨVi.oVڷ[eڏ2t6 endstream endobj 270 0 obj << /Length 156 /Filter /FlateDecode >> stream x313T0P0bcKS#CB.cC I$r9yr+r{E=}JJS. @-\. =2>gg`zp=a&f?qA|.WO@.J endstream endobj 271 0 obj << /Length 205 /Filter /FlateDecode >> stream xڍб0# $ hA%1!ALd08FWxX`|]ۑ5]2hH}sBK&rjиjO(6d9(\G.zQ(ښd0 Ԅ9F"Z ,EIIQx %U4d]ԆG mQMSe[p )yX$>A&<5NX endstream endobj 272 0 obj << /Length 230 /Filter /FlateDecode >> stream x}ͱJ19X&ywl 'pVbvb7[E(6W77V80/̤mfRɾ@f|mcqw<︼Բ\vgt|y,/䲖ꊻPLdK?t4g1:Vu&*ޠw#¦%{"oOp($BJ(D|p0hs^>۹3k¸ cԤRP5y>ZsY endstream endobj 273 0 obj << /Length 154 /Filter /FlateDecode >> stream xuɱ 1 ኃG0O`\op Njh(bl-?崚aUÓ+>$?*_5o3z  H1D>1Cf$t cUIa.<5Ga D"JLKL`` ?:R endstream endobj 274 0 obj << /Length 194 /Filter /FlateDecode >> stream xu @`Ń0yVq :fNSuPY7|;4kuhgd4GO q^ͷ=@X f܂x>] C)C 6h[ }POmwj؊n֬GerۺInOs&y?ͅ_[*o&+jIhiKx endstream endobj 275 0 obj << /Length 180 /Filter /FlateDecode >> stream xm1 @ )xnBVJBBB"^do)BBbFST@F R/r@)Z?K6A}cE- ol}:X}"j&xovV$GC* ~f endstream endobj 276 0 obj << /Length 198 /Filter /FlateDecode >> stream xm1j@Ep!fsZ1d"W.B*'e h{A (&E a-]{^ҙ|Xr8}Rݒ;=K}A~qIג7j$2%32 ]hzdLs_Lä_Yt:wjh^H;FU.o%mZ-/LRz endstream endobj 277 0 obj << /Length 230 /Filter /FlateDecode >> stream xuνN0:D%{:&KmȀbj@y?BFi>@UJO򢸑Lȯ9Y^.wv™/}UI\ |~|]=%g\.7B>@T*ƒvPU> stream xuαJ@ )#d^@7!;N0Xr׺Qro`Y#\q|,Oۜ/Ҷ,7nV2oFOKds9F6۵l6PKF@f*;!ɅY$ rHT 'HqĘ8() p^we  * L1j ~-Sё1qx 0hD^)㫎 Zz endstream endobj 279 0 obj << /Length 179 /Filter /FlateDecode >> stream x}1 @]RVBVb(9BʈqvEy03L8I38Byrj5tكL@N0ހ)PR+IFdޒjIWZE,& *>`۰m$jKaj` U endstream endobj 280 0 obj << /Length 206 /Filter /FlateDecode >> stream xU1j@Eq!fo Rd\ l`W)B$e\vG)U8Mb3KtkZ>iyW]VGmZ[wy|گѧZg7}'8l"M !#T ppP\`~ԅƲꌀEwKr40À0=O%AnRZA endstream endobj 281 0 obj << /Length 176 /Filter /FlateDecode >> stream xuϽ @ nY ֫ 7:9::(>#tPCÑKm8r#:&xAk%5ጙC%k,ƭvd9%hr%HDbfRA#JA;=LVi@ &!`nOYo .n R endstream endobj 282 0 obj << /Length 178 /Filter /FlateDecode >> stream xm̱ 0H-}SV08ͣ7#tP> stream x==@!$x.d@ b&ZY+hq%g+̛@.Wy!5||4gN>0U(N$#;NQ=_;!EFg ꚮ~3 |4ؚ4#\Y]gr1WOL$ǭ#bVO endstream endobj 284 0 obj << /Length 197 /Filter /FlateDecode >> stream x5; ` %79m`A'qRGECGEzcokB>bw!ܗ&QvGlE/rPPMycEQѷ(5ҕ;i?͒5-7-ǫy! ^P+́<$r4+n "ID>8q?U endstream endobj 285 0 obj << /Length 216 /Filter /FlateDecode >> stream xEαn@ PGNO_KH@b!`b@L#nvH0e`'wgFJ)S)gG, 톊!څTVK:V6t՜b%71w%;]ͮ:$δ & nKoW1]ЋputF@uFjM0>ɏ) N6#0˾ j5>[ endstream endobj 286 0 obj << /Length 224 /Filter /FlateDecode >> stream xMα@ )iBy` A++Q);l3j:-(#IorNjNӜNP6hW%OR9Q[Qv$QKRvrM`> stream xm= 1F'Xxf׍ Vº[ZYZZ( vz4GL?13yL`(d8.,mv}zsQ]볝bʶxޱ-cIٖJ%YsU f7[q(hV젨[it'zS[ v.Q*FEQ"x ?>&Twse endstream endobj 288 0 obj << /Length 221 /Filter /FlateDecode >> stream xu1n@Џ(Vf\^PXJQ*;eDv mGt .4#Jنc^"U4aY:m_ȼqy1'ˎ2%'PU2| (2w(ڦE-zD6BF{DIڝ3?mgDj # Arf#rNN,t']c^al оWqi7 endstream endobj 289 0 obj << /Length 170 /Filter /FlateDecode >> stream xe10 PW"y#' MKUJȀC X)GQz U 8eSI< e 15ߗ rKIr5JvDYPT)wK@1c5 0|2 GAw= /t:pZi|m˸иI Pt endstream endobj 290 0 obj << /Length 229 /Filter /FlateDecode >> stream xmбN@CA2 <əXg"WYBh<>%aKK6eg]B}}k{oxⷊ>.6-\WT<*#Syc]nyv@6CG'=D",2dfFz-mə1:;_w1|4t4hn7)xM> stream xUпJ@YR,LGȼnb.r6?` A+ RK E*-GHEq[E}\I)rVɢB+~ziRz>yzu^%k+snv#r69MD^HjO@IGJ3&`MS |08oF xo2("~B9~}B@BTB_Cmc1aH9ԝz xk endstream endobj 292 0 obj << /Length 214 /Filter /FlateDecode >> stream xe1j@[4'JT@!* q"JR n+s.*70‚,̃0ir$CdKyyωf^ˊ$9GlӃlKZhYqb~OC~OxCH7L-VhPjeL hA؀&jΨ\5әcts÷|*f endstream endobj 293 0 obj << /Length 247 /Filter /FlateDecode >> stream xm1N@ D'JM_C~QH@Q%Z6T({-SD1Q Ѽcgqwm݉>4,mFG K=\ۣԻ3mm; d plFar&@GPي>pOc({zUAL/.ީ8|ks endstream endobj 294 0 obj << /Length 202 /Filter /FlateDecode >> stream x]; @GR2͚Dp A+ RK EBRZ㬺8N(->GCW;]@G5v*\ jwR] endstream endobj 298 0 obj << /Length 208 /Filter /FlateDecode >> stream xm1N048ViSYZHPQ *X}4Gp"Z3yH8^ۙ{8p7Kg&Y<̿:.dxɚr_d7lɜrBˉ ЖVᒊK(RsJ jgJZ.CW|p)m䊄ȀjC&6 ]Q:\x$^Rߖ=F ۅ` endstream endobj 299 0 obj << /Length 242 /Filter /FlateDecode >> stream xUбN0#ԐT4)IAAL-" b&D:!b o:~7$y endstream endobj 300 0 obj << /Length 207 /Filter /FlateDecode >> stream xڕα@_,Gȼn"H88+*T ײ5|.E07$G܋x0d'<|nV[d'd>%&pڐ~8"3矈_ LNzh=$e[*/P7 }V[82+ww\[SzUХrvL}䴠_R endstream endobj 301 0 obj << /Length 235 /Filter /FlateDecode >> stream x]?J@/f0: %),+r Eē^!GH9B&b=-Ӳ >xYp~=Ң0弜n$s)1^vd眑6 GjʿzBM?ڪJ{;R~1kl#Bwaɣ@+`&gL #ӭOF-?v5cÄ ğCX<=*@5uy% endstream endobj 302 0 obj << /Length 193 /Filter /FlateDecode >> stream x=α 0 [| hR[P@`A'qRGE7ih}>B%Y$fdhNC.1I(wsa>P> stream xe1@1$p, j# b"VJ--4h PRqe0IO_ChD]I%9(fw8E&?D1Ez@/$Q$m1M*[5J-2 5MxiQ_+Q(YT 0awEγ).R\a` endstream endobj 304 0 obj << /Length 239 /Filter /FlateDecode >> stream x]1J1෤x;Bt&̢uXBNf{,x#"3KvuuO wgd6 /K{n[suoXo/` C5 g%Fى_$ *X)YGrt@F 4xl w3Kbl1;RtU^\h'_ O`EK<"_īpa endstream endobj 308 0 obj << /Length 99 /Filter /FlateDecode >> stream x3532Q0P02F )\\@$2ɹ\N\@.}0PRTʥ(Dry(3773pzrr{ endstream endobj 309 0 obj << /Length 205 /Filter /FlateDecode >> stream x}ϱ 0[|Fq+ vtr'utPty>JЂVCAn C>)NB<pmkq jZZpTvfJp4A!|ܚRieuݪ,;鷸"Umddgf$/qF+Q+]KC8ptj䐆ŀ "#$ʣN[ywa endstream endobj 310 0 obj << /Length 215 /Filter /FlateDecode >> stream xڥϽ 0H>AAA9>ZL@3wS̰o8xp|)30-l1Y2rf3ǝtC)"l˒PK^QtJ*X endstream endobj 311 0 obj << /Length 225 /Filter /FlateDecode >> stream x}1n0 Ed0EG0/ ԡȔdР7 dPK#O'O *k!XnKVz>uөg^3e݋}N7Oo#XnkR 0,H"`nX,2d;F)ԃ"G ٦)eC$9َ}r9H>Gime2bֿɯꢻNǀf endstream endobj 312 0 obj << /Length 223 /Filter /FlateDecode >> stream xڭ=0 S1T#4T HbF(=BN1#2|QlSL``: Ҍ f}a^cstz=^NЀ`|U|+Q܏JfL5IbG|86*Um%1x(VDFN{ܙmw^{Ǜ)5xu Vϗr endstream endobj 313 0 obj << /Length 208 /Filter /FlateDecode >> stream xڕ;n14s5,r%[D ")S$"r4Gp`(RF}?i7> stream xu1N0E49BM,)@T@"萒(9K. #3?pW=w<~(ё6[;ϝFOْSxϟ_dw7qB#h%^J"s-,&ï& M ugTi: d)ȧֿHee_3 Y}ETԼ4rs$jYh%t;#k} endstream endobj 315 0 obj << /Length 141 /Filter /FlateDecode >> stream x3532Q0PbS3#CB.c3 I$r9yr+q{E=}JJS ]  b<]0000PX?Po?=``D xr "cn endstream endobj 316 0 obj << /Length 127 /Filter /FlateDecode >> stream x3532Q0P0b33CCB.cK I$r9yr+[r{E=}JJS|hCX.Oc`'\{0 ?0%\=Rm endstream endobj 317 0 obj << /Length 202 /Filter /FlateDecode >> stream xڕ=@ #0e't$$RheaB5pJ 6&Wd^狔cy9ƹjzPRei.;-+RGN R[&U|H-+֤|Z3/PDx"_  {MءlQ5򃠳RkD0qM]Is Fk,Uel m*:9n endstream endobj 318 0 obj << /Length 172 /Filter /FlateDecode >> stream xڽα 0@εIG882:Ht>85g<G5oHYc\lːIN͌Od>"YJq&S"EE\-u׋p*X&.EZ7-}K7-^D_~417yi endstream endobj 319 0 obj << /Length 227 /Filter /FlateDecode >> stream xM=N0j K.Yo?)@[%h(pGH"1&+Ai4絻RF.x/~-O_yUì o[^fv'^TGnBe*TRUCQf4.,B"tF) F#a~̇ Lͥ2~"1e`9Cf1YD5- VM4kcЇA-ʭ endstream endobj 320 0 obj << /Length 177 /Filter /FlateDecode >> stream xڭб 0+ 4%q- ftr'>#t =/u AIn(ƚ!kxB%N_C!Q-$Ft9_Ռ$h+3;tA|y=8ނM?`|ҋ-xI ,vQOzxE:Vv܄#Jsk|jVmx endstream endobj 321 0 obj << /Length 165 /Filter /FlateDecode >> stream xϱ 0]r cptBp" hX ;;rpcHQT2kv%d‚ϧ˞L%SrPE^ />" _*?_^ӗw/ķ=yD-L@@+z]l endstream endobj 322 0 obj << /Length 224 /Filter /FlateDecode >> stream xen1 } p~r$7 1юZ(yc+ d/dj I8&,‚}bTl+bY\2L5N{Gs/Pܠ 1?3W-%_} endstream endobj 323 0 obj << /Length 251 /Filter /FlateDecode >> stream x]1N@б\D&Gع؎HT+  * ()@*>Vu,7O?_f竂RlSqAENObQ4xz|M=%&>ǤgL6aV[2(̭v 9LJt'XX=YjUI+.~ЉgPws+CF`CHeD%;#7R NJCwX}xU~ endstream endobj 324 0 obj << /Length 179 /Filter /FlateDecode >> stream xڭ @ @#B~B^=] I{O3鬛A.oď9”Cg ι؟nm8]r;W3zw6%%YUH×y4g Rd\\\grI,'rI65~\x\ endstream endobj 328 0 obj << /Length 167 /Filter /FlateDecode >> stream x=1 @7h-XYZZ( ٣y!)kb@x0)=r0a?pGERQzpDܲH^z?L+){{)'q?ɭqF A@^~QiM;Դ/g5 endstream endobj 329 0 obj << /Length 105 /Filter /FlateDecode >> stream x3634R0Pb#CSCB. m@ $ɥs{IO_T.}gC.}hCX.O!'W ( endstream endobj 330 0 obj << /Length 114 /Filter /FlateDecode >> stream x3634R0Pb#CB.CS I$r9yr+r{E=}JJS ]  b<]Q?dX x~\\\>? endstream endobj 331 0 obj << /Length 96 /Filter /FlateDecode >> stream x3636Q0P0T0P06T02WH1*2 (XB$s<,=BIQi*S!BA,\\\5^ endstream endobj 332 0 obj << /Length 187 /Filter /FlateDecode >> stream x3332Q0P0bSKsCB.S3 I$r9yr+q{E=}JJS ]  b<] 9?~0a``cR؁:5S`)`R(C^ yP:5>Փ+ c endstream endobj 333 0 obj << /Length 383 /Filter /FlateDecode >> stream xڅұN0`G,y`$ҡR$2 ĀRJc7d帳Â9q;e]T+}\uR?TY+|X oĶōWǢh/ۣ(Wg;}[N;XGIQEuv"/5A|bGK&itHșEٸ()9HH84&i%IT*qK;g2I Q+G~CƯ=\/ctUP٤I0;-PD >V9j̘a&ba ¶->Hg 's8Q@óEu><{=TeĔo8 0P%g9:IkV\of endstream endobj 334 0 obj << /Length 291 /Filter /FlateDecode >> stream xڍ1j0a  jR'YbHSB;u(ڎZڭؾI=JIqT`$/VI~k,sOxym ɓYSH{dsf=;#ҍkTNUD38L41裵>+*bT)?d C~yE}QKZq<8ZTb+Ώ1ܼn NqA(F.gEㅸ$ > stream xŒ=N@ M!$)fE"T (AKrSXؓ,=S$_> stream x3137R0P0aK3 CB.cS I$r9yr+r{E=}JJS ]  b<]lQ3\=i% endstream endobj 337 0 obj << /Length 286 /Filter /FlateDecode >> stream xڽN0 sb!~U1U:H01s(};R!F:$_؎k{sqV xZa%>Wu kyzm 7,C ۻ+du쳇vι:>H%0h}GONhIl+"$>x$OA93H:7ICc0C0” d4rGZƹ3h醥A:w*8,;$qQRrWEg{ !Љ̳A:>6@ chٰu } endstream endobj 338 0 obj << /Length 251 /Filter /FlateDecode >> stream xڭ1n0: w֠4YDH!d̐h9 G`j1RaKd}22yPD zIP"eDݓ̛ ŖdbQQdoiSEN܍WƩuJ3dkYAW fuM<7'Mn݀ASwMR \So'%uvrCh2<>\+#_2ocibBר?i h endstream endobj 339 0 obj << /Length 305 /Filter /FlateDecode >> stream xmJPO"pyfaa]Vbv ɣQ)#\83w.x9zuhI5t^Sҽj-%]2on۸+n$>?^];z,i<H90w{1c]< h=Q=6 zh,݌$d1b׆ا#XA}ăiM֩S-dpAí$ r0cGݑ"y*\'5 К?)ԜhVVQnܽ endstream endobj 340 0 obj << /Length 232 /Filter /FlateDecode >> stream x}ϽN0Jl;Ta?pۜ7kBjikVb7/;8jC'_o6RsS-3[&0`Q0|T*M *pӌ_2 $Lo1ÔJc4|ݜ~82;eSz)<8`͊N9y{2hl endstream endobj 341 0 obj << /Length 229 /Filter /FlateDecode >> stream xő; @72M4(SZYZZ( h"8P+q3z ;MVYmcsd4ٟ9ą!8~̸+fܒ^ ke"e, tGd?˄b$U5Ҋfl$*lMgn CJhVʷ3Fip endstream endobj 342 0 obj << /Length 214 /Filter /FlateDecode >> stream xڭ1 @E'l&G\@7E1#BBBQRgEv>'S &3!3c4#NqRdn uS:]L> stream x1 0yд*N`A'qRGEx 7бC=q(8 vي1&]lwqy,N1y 6n_pa8&:2)љBztUUN+IZ^>j$qIMMR'*mse cL@I 9Lwni endstream endobj 344 0 obj << /Length 226 /Filter /FlateDecode >> stream xu=n@gbi|eYGH@TDjh> X VyyD%JC80/*v[ dvջ\/_Gvxv+١hJʞ2Ն(W FOFFl@&%`}b zdeL,>2~dgygL[41Ƕ hKyJ BasQ D endstream endobj 345 0 obj << /Length 167 /Filter /FlateDecode >> stream x3632V0PacsCB.cK I$r9yr+[r{E=}JJS ]  b<]700P?aA<$AD0H0 A6b#4o@ endstream endobj 346 0 obj << /Length 281 /Filter /FlateDecode >> stream xڕ=N0’!sHE"T ()@`)<؋$'{Iן5-5tA-ukZw75oZOv3RpC/^Rk-=ԣ/qZqg XxqdWjIpnIUi+W%KK"5-CiK #;A58E, k΢SvYlK S^`%*#G4dPɲ1:^.eiiC%>+^ ~ endstream endobj 347 0 obj << /Length 167 /Filter /FlateDecode >> stream x3332Q0Pa3 TH1*25\Dr.'~)PKW4K)YKE!P EObPFS@ >? uBP?(lԁD(.WO@.Jm endstream endobj 348 0 obj << /Length 131 /Filter /FlateDecode >> stream x3634R0P0b#KsCB.#1s<L=\ %E\N \. ц \. 5 7?D # P?P1?H{pzrrD endstream endobj 349 0 obj << /Length 186 /Filter /FlateDecode >> stream xՐ@ kH#;#q"ALD'㤎xPK~m<S "PcmNJf_w8cfPn)(V4+]'zNʜv=@A/ q.n1x<}!77AuuڤK<Ӿ+ >փ endstream endobj 350 0 obj << /Length 107 /Filter /FlateDecode >> stream x3634R0P0bc3KCB.#S I$r9yr+r{E=}JJS ]  b<]0q7c.WO@.S endstream endobj 351 0 obj << /Length 209 /Filter /FlateDecode >> stream x? P C!;Bs_ZA,T;:9::( n>'GoqQzJcߗdڍZE5eujh}OSXcu4vB{%gQh@&lJ2DxbΪUdK 9T`P+XU.> stream x3332Q0Pa3 ebUej 䃹 \.'O.pSS.}(BIQi*S!BA,C}?7T10@ 6P?|'W [ endstream endobj 353 0 obj << /Length 213 /Filter /FlateDecode >> stream xڥ1 P #B[SV N⤎h=JбC1&E\|>?dј>c &tA$GOX4 "4 %]/#d5#MJ[h6%y=\0`..Y尀AK<@\@Q#6-WQwu;Sw ?kBKn&j״1a>7k.sk|]ŏf endstream endobj 354 0 obj << /Length 161 /Filter /FlateDecode >> stream x3137U0P0bcSCB.cK I$r9yr+[r{E=}JJS ]  b<]oH?1"~`? L7?bl'W n endstream endobj 355 0 obj << /Length 223 /Filter /FlateDecode >> stream xE1N@ E?b%790;"E"T (AKq%GH"4o4v]_+^sk{w6[{T^o(=fKdJ~|Q_stgj8UR:EZ ʷcVG@VjU'3rع: Fg u1vM#bj2;4@* endstream endobj 356 0 obj << /Length 173 /Filter /FlateDecode >> stream x3135S0P0R5T0P03VH1*26 (@ds<M=\ %E\N \. ц \. Xv8'=3,X w'C=`?`A<7@ ? r  ,t endstream endobj 357 0 obj << /Length 166 /Filter /FlateDecode >> stream x+@i*6#06&$  (D@@/G[58"e9P!Zj Z)%eʡ^Rv3:N[|LuM+C]MD ! a9PIcУd/-x>o;w*!aVB78\ d endstream endobj 358 0 obj << /Length 126 /Filter /FlateDecode >> stream x3530T0Pb 3SCB.c I$r9yr+[p{E=}JJS ]ry(000```` H0@,0%#zl'W  endstream endobj 359 0 obj << /Length 266 /Filter /FlateDecode >> stream xmбN0|G/qCyfίF0t^ߟlߣO;O$9 1!rHdڈ4f&pBl9{Ð68,ִ/vKqbҷ+tي%+NC7"EB8сVP #RI*h~j:Rᕤ[Il`Φʗ'& endstream endobj 360 0 obj << /Length 258 /Filter /FlateDecode >> stream xڅN` {@ $g%^Ltr0NzGh< @= icu]RHRb)U?XHUw>5?1r~geΛ{p~z< 7g!ґRUcR;Q2QP:X Ja2m0{tƔyl[J8 XϠ-AvHxiOzMYSgčV6oGbǝ2ClčLU[ϟ]~(6?d endstream endobj 361 0 obj << /Length 216 /Filter /FlateDecode >> stream xڭбjP r7DpI *NJ'utP-4|-7_խmzޏs/{Ck#ґS]ŲdbkFR̋&1 {*|ZL4XL_m̛3ul󇚴] I@BI /s'sABNjAOB/#&-'5o#Rԑ endstream endobj 362 0 obj << /Length 253 /Filter /FlateDecode >> stream xڥ1N0 `?uGx^:bF4G  Gءj]&`>EIc;Gy:r>fG}=~@{M;vyJn-2ЀL]_~EI-jV8Yz&? }Bs훃$ShjMM|wSSYN-Nm8NZT2f5JD 2Mr[μ̐51= x_d endstream endobj 366 0 obj << /Length 256 /Filter /FlateDecode >> stream xU1N0EgEirH.ҲH@Q%$ $&\G\2qi'cgr.Gtt'+ڔn.a{\^h$t)w؂2`Ĺ%"LH6Jm@ FhUj ؈Eeh~rjd!Cf#2V4eOVj,4ڣf#ͽ8cD)'y̗F endstream endobj 367 0 obj << /Length 175 /Filter /FlateDecode >> stream x3337T0P0V5T05R03SH1*2 (Cds<L,=\ %E\N \. @b<]*@`&i~ԃ?q`ԵJ'DB $AD| ` d'W ʼn endstream endobj 368 0 obj << /Length 258 /Filter /FlateDecode >> stream xmN0 u䥏<m*D$02 Vzҽ@cw܁$_߱\g9V{ƿ6vVSw^\=v-\wc'y~;Hd$8ix I["S1Gz ( 4.l1atQQ,+rѝ9(kEvM()Y*tV˪.XMPՈKT*?,E~C$)%oz~?ᔳ endstream endobj 372 0 obj << /Length 93 /Filter /FlateDecode >> stream x3231S0PbCK bU@tr.'~%U()*Mw pV0wQ6T0tQcoo u 6 \\\Tt endstream endobj 373 0 obj << /Length 164 /Filter /FlateDecode >> stream x3131Q0P0T52T05T03RH1*2(XCs<L,=\ %E\N \. ц \. ؀L1C)0 PB@B|PX5ـX :NcV  \\\- endstream endobj 374 0 obj << /Length 117 /Filter /FlateDecode >> stream x3231S0Pb#3c3CB.C HrW04r{*r;8+r(D*ry(001g | !h 'W % endstream endobj 375 0 obj << /Length 153 /Filter /FlateDecode >> stream xM= 07 '0?Ь {#(9Bǎ~L+a`kҋ\j \1MU ΓqO:y狼ti(ԐQF5!Kl\IYufdY/z1%+YN7A@GWU2k endstream endobj 376 0 obj << /Length 96 /Filter /FlateDecode >> stream x337T0P0W04S0T02TH1*2 (B$s<Á\ \ %E\N @AhX.O??}r Iz endstream endobj 377 0 obj << /Length 143 /Filter /FlateDecode >> stream xm1 @ A-, ܝ,Xn!he!٣y#su{O3AY,|gW Wt:y6+l¦, lU:겷Yrb:&\2w1 endstream endobj 378 0 obj << /Length 95 /Filter /FlateDecode >> stream xE@@ %Hl!R :$"$)W 'w 3$krZH 7-n% endstream endobj 379 0 obj << /Length 219 /Filter /FlateDecode >> stream xUн@]X"yp7O&Bt),J-x`+ BX3wf>fQ6bG)38Afkbwq f̼)s>/'&t EP>{Z;f,OȞ?B]}t1LU|h!L+^ި=I T̝B?Kk Y +xir endstream endobj 380 0 obj << /Length 275 /Filter /FlateDecode >> stream xڅJ0顐}Ͳ º=ɃxR(y{(3itG&dfd^QAeE-Wt_g5G ZQmj_*Kz}y{Px[Uo @<9uf8g:&hFO^|IN{?,''Oi%_M ?KӴ L z@;u32<ی+٦ JfW-ƽ<%5ߒ uP:N}m endstream endobj 381 0 obj << /Length 249 /Filter /FlateDecode >> stream x]ѱN0ٮfZwnB{G4Q @dNAB^=IݠTd%s]Ksbrh6@^^43{2豹zD!;(d`!mXm ZB$BRm7WKPě_ ׊ endstream endobj 382 0 obj << /Length 245 /Filter /FlateDecode >> stream x]JPO\g Ds Zj"ZU`Ch(>Kf .;Mb٩qg%wq.M27Vl~k>?^.L*veS> stream xe1n0?`- С*RR3TCHRh#ddA vk{oÀc6v6c^'##9(ՖҌ!jOIgoސNSNH#xIٌ;? *rħ>h KurFPwV ᥬPu3ZB(MnL| .G}Ykz~m endstream endobj 384 0 obj << /Length 208 /Filter /FlateDecode >> stream xб 0[VZ N⤎(}JK@ȗ.#fREP3sҠraJ !!Lv(]pgt.8÷ xY4}k]FhaZ7C|ݩxS)މZX* Sd endstream endobj 385 0 obj << /Length 155 /Filter /FlateDecode >> stream xڵ?AAWl2#dK$P)DRA98b|3z8*qq!lK,f!+zS/4qhTQy~1} 3MP u|f*ez7"ȅ``_St endstream endobj 386 0 obj << /Length 203 /Filter /FlateDecode >> stream xMα 0+C '0AI7h}>BGbE1 䃻dA_$);tD/8,y bC lQ%ݮ#b5Ō Au D Dfc9-O_pjϷ3mߗ3m߮ 5Ꮯ~66f;_+Qqɚo&V&9Ԡx d endstream endobj 387 0 obj << /Length 300 /Filter /FlateDecode >> stream x]?J@"{3'0   BRUx #8IoEZ&>Sz ŋ( bVEk_k$BߩP")$ NHA?%A^ |6^@(.:\= )ʛɠWQY;XvrʚTf;<+fT QR8vʙYeKa hd'I~:t'mi ٪ #JkRBVAn+q饙 endstream endobj 388 0 obj << /Length 266 /Filter /FlateDecode >> stream xmбN@!$;/Hl<)L0Vjy팷ƣp9L0@eef./Zr)6r]VWVRŜzI;s;gۇ<p"OO-.47RDS4EYRzcfc=Th\KΕHg:Ád@ůq _e\o ә͌Ec@[ѵWKY6' PǝѶpl>6ȿmy endstream endobj 389 0 obj << /Length 325 /Filter /FlateDecode >> stream xmJ0)=ru=%/m-+AГ(7|@ƙd -dtOHEv*R{q.^2ΊSqV 7Xr/%X`Iu#>?^YK6!#6=#mKQGk:0H7V/Aʑ'zP5%4A?&4cN1|lgubi4g娕ˤvMejVjlY ÐJoZ`Zpp4TRa;!%-_@z:!#=Miyݱv endstream endobj 390 0 obj << /Length 261 /Filter /FlateDecode >> stream xMAJ0)]fa/sm+"BЕ quBQpG ihMIyM:dhOsj錎Oi'a?bKE67xK/lﮨfGO8ceID``g&@Y953ؕ#˙ fW<@ Es>(R :$V.bA*3J ʘsJڛ?&JI_B)Jr&| eDX#d? endstream endobj 391 0 obj << /Length 255 /Filter /FlateDecode >> stream xeбJ@?Lqy1;y),J--ɣR\g&w|'[1Ϲ#^<PSL[.V_ʘ^ߟ(__7|=PaH(fTA#{Ľ8=Nݯ#_+Atj֛4H`~AWQ~,@EkflF[b[Ϡ~-(N[NA/V袦?Fj endstream endobj 392 0 obj << /Length 214 /Filter /FlateDecode >> stream xUϱj@ `ZB'㐫S0NBc )-t͏G!z3HKh{~\.hN )')+,9qs<\>1-_ -ޱwz𐴶L 73nb. fV cFI, m%5Ҁ+IIbM/1Nb5'1UWwݦpt endstream endobj 393 0 obj << /Length 237 /Filter /FlateDecode >> stream xmϿJ@/lq0YeMs8O0X`g-GH:3H?f|3{NS.9TTg+~N1J]ji'Okse|sß_/w!pH͞S4M~Ba\deE'XGbtf$oJ!wƠ! jX6!p`zW_H C3>2\_&66gUCwh endstream endobj 394 0 obj << /Length 212 /Filter /FlateDecode >> stream xM?@oH1\@ȻNbjະ)+P $`Nog7)SdgFA/}q7`o:Ph>ggiLjaDGIſ|:w/Hxx@@6/cGP!R^!'TH3=,њR;gXK%Hs$h%Ƣug+> stream xMϿ@-70&aÀVW՝rWGˣlg[QsŧMyK)!Jp1|pԠ:_gzPzJ S ĎԬjukzE Q)]xĎ/լeQPxўc=r_0%t,!_ endstream endobj 396 0 obj << /Length 186 /Filter /FlateDecode >> stream x]ο POG@] b`955DS5f&>$)5}6+X8!C %jPfJ`Rjן旭Zz FB!‚_C4KhEoM> endstream endobj 397 0 obj << /Length 237 /Filter /FlateDecode >> stream xUαN@PL#0/ H3D+ cH 7Y0@IAXcClbv?;92Id#GdO!g^&^xWUc奼=]Iz/$w\G ~=BO \N nkm``\MdG :5">fg|w3ތT8ڦLH[e"48 6I|k endstream endobj 398 0 obj << /Length 193 /Filter /FlateDecode >> stream xm=@!$ S $&ZY+hfx=%-l,f&LC9QQф)LLs IK^nGՌ9owT p< AZ-@:hM,љTY(P zG߁ؐIavU.R8Uk Z B endstream endobj 399 0 obj << /Length 216 /Filter /FlateDecode >> stream xڕб @ !? 4?Z`A'qRGEC~Z?O[&\A.rIf>n,؃ҵṊw0 A.vAN(2pڂFh pi0@!D-%\"ōr"R\uTP\(z>Saا#|sfCuL1>|S$^Ik,b&rs\ ;] endstream endobj 400 0 obj << /Length 236 /Filter /FlateDecode >> stream xEοJ1YL2/ٸ{y[Z]!Vz ({h_$",I曯^SE 5=:|zӊ%+mmvssAUn @E2 Ȩ1JAE8Ab„rg|FÄ d]2Gd3Kꖂ''Bǥx`:!s\I`~zNx /[_TdW endstream endobj 401 0 obj << /Length 229 /Filter /FlateDecode >> stream xUϱJ@7^~@gfaŁuSne!Vj)`̧S"@-Fa0a.wӪ,NJ~CW5;;׈7vu{)%۵ܗ2{z- DfJHG"|Z֦Û)`tfTvh"?|@QZ計VШ@01E-e҃nO;`DhI|Ud" endstream endobj 402 0 obj << /Length 187 /Filter /FlateDecode >> stream xڅ1 @R,L^@ܹn),J-m5M)Sq793?<~Qq̇.6Ҍ􆣀žIgK]Gj!oCv^a JH˸;%BX[O ԎgU[kM4FF~xϕӁBT hњ~; 9 endstream endobj 403 0 obj << /Length 215 /Filter /FlateDecode >> stream xڕ;j@_0La]Dsy?* I"]I Eu4GXw[ Ɲf|8☣,> stream xUαJ@YXrM.A\8O0Xe _|XFlR,3m/ʽe4ݜg4/6G,r|{eSVgrvy~L9]]c"-"46"n"ja g\ô 꽅}abZvLRȴWWqz=A腁=AFZp2Ǥ>}m1fxԑ0S!9TxR^ endstream endobj 405 0 obj << /Length 172 /Filter /FlateDecode >> stream x}1 @bم #BBRPQH!(9eٵ(E!/I )txAM )e8E!Q,LF.vQīI m%;L>?9:^j7N=j AvG ) E endstream endobj 406 0 obj << /Length 266 /Filter /FlateDecode >> stream xUAJ0?dQ^`0v:B[La.]WRU'GQ2xɢt|MUG^dy*W',WOxقt,ErHh,Z}> stream xUϱjP? 9/Pc0$Bj;u(ڎV2HQ#dt`]8x)?DxgDGNx/4/)|8Yb o7/ K7Sd蓺@7=bTEVӊUш?I4M;@AmQSuj#S}7~9`^B 詤tU endstream endobj 408 0 obj << /Length 190 /Filter /FlateDecode >> stream x=ο POG@]A(AAM T EmB/fo#AB߁;ˁ.=t谿6;)#ɭI;~=7~.ɄO.;gJ +92 = Y5"$*GE1_kMAێfb)n! a!"t5}6)G endstream endobj 409 0 obj << /Length 238 /Filter /FlateDecode >> stream x]ϿN0/!Қ?"R)ĀZF@j?y=D $|jr=.YMxzH]lo-_iVSȪNTBᆥ:'zzLfU/2k`&[~6bT~4Ѓ{Νh{FRDJ*+oFt:^Cf\8،&и%FӶt[ӂ~Jl endstream endobj 410 0 obj << /Length 209 /Filter /FlateDecode >> stream xE?N0gy-9 K+" &22`l%G U:mk>i.e{ۆɖs_mhՑybے9??^ɬn! x B`'#"QMU1"Q~9{Hw\fP3] ˃,a!aZW}p{EL~& < xD=/8b endstream endobj 411 0 obj << /Length 182 /Filter /FlateDecode >> stream xU1 0_:`/PMCv(j3:9: U:zI!78QL#NN"# ÈDkg%- lcdrE,_ω#+h(  0RGC:k3dV4P` {@1gy9xΡoi|KZCf1.$n > stream x=ͱj`27h 6] fԡtҎ*:H|(V;QX\Fje%E)MT̂k1RvO1j}H9S B47Z4^7^;r<ȇ0)z!Be,; e__=FʼW|/Hd endstream endobj 413 0 obj << /Length 178 /Filter /FlateDecode >> stream x]1 @ )tMBą-,J-+GQrBt |(1%2EϨR.#ʒ;baPI(\4 ^nrJ1ʒ61E[4%o!Au4x@u/YqDwk;ppjhWO: m 837ġB endstream endobj 414 0 obj << /Length 216 /Filter /FlateDecode >> stream x51J@o";MBuS,he!Vj)x9a)BpSo\^]s-_Tܴ\ZKӶ5w1S WT##M~!J& zt9Fauޝ"Ya b&91ĐMJ^-}?9:o,Uێ;VF endstream endobj 415 0 obj << /Length 205 /Filter /FlateDecode >> stream xU1j@/L!]Xsx^"W.B*' v+h:aKxl%4ol9dxaa苬2g@˚%t§'3+~3Sb$PTh$&w;.Cչ Yw A HD)Ԁ TC8!#_^P=WDC)k VA endstream endobj 416 0 obj << /Length 238 /Filter /FlateDecode >> stream xUϱJ@?l0 ,GH`<Vb) rGGG2ENS8`vfv,]W|測y]7* c]WtsYP~-iʻx||s{Ɏ-?8.2" 5B+h&Q[Xo}f?BAqa#G L0P3 (E>QZAj4Nq12!Qydq-`l.vL@Wa endstream endobj 417 0 obj << /Length 216 /Filter /FlateDecode >> stream xEͱJ@R "y/Iv"f!XW0bBKGGGe,+SS_l8 .K6R;s6iy~]Kف͖%S+ek.(c{AzDjUW>snVn-t +ʼ23;_| J%r,cQv$F)XF\@7-=sJ endstream endobj 418 0 obj << /Length 243 /Filter /FlateDecode >> stream xUпJ@/l¼HSge!Vj)DN.>Z:_ca;SQ9m~ )T38,>')f(eHzB %m.ALsI7zkv+FQ"q I`{}w3 faB=3 ӍKM;t~='s.C˱ |GewUû%sLrȕ|ob3 endstream endobj 419 0 obj << /Length 211 /Filter /FlateDecode >> stream xڅ1j@EP0Eš $+1`bp@R0ؠ:#lf > stream x]бJA?l0> %w'6 ^!he!Vjihw_le+B\&L/lEe/ˬb2b|y~e-Ag%Է*ayw>=IR4tI6FZt#?jvOG,I#1>- k`#؎ yD}Ñq ~`[ u^#g endstream endobj 421 0 obj << /Length 176 /Filter /FlateDecode >> stream xm1 @ iILT-,J-mMxB\'6OB(4]'v;,4.UPuDuI0v[>˙i7 w40`V.v^'VOȬh/|5V W5cjSK.[HG endstream endobj 422 0 obj << /Length 247 /Filter /FlateDecode >> stream xmJ@?!0A;/IۄPjsAz( 5B?ԃvqYjMkUDdVj>=ʲZg编Зɗ:|7-nY)zyK=]IDڒ 02F z :IKp>l;'[rŽ^C4a p7y0_v4,0Ƣl-؁Ԣ$K/Rc endstream endobj 423 0 obj << /Length 250 /Filter /FlateDecode >> stream xM1N@o4NR.2Et,7s-%. +*?[ΫJ - =iԺ֧Rv2_Zh> stream xMJ@E`$wy)+P,m-r3_XXfvrqV녞.<תҧB^eYkUv_dJvZk%koYmAڍHf{`8""`~`'i8،i'~aa 73PcRK\O0! РgV:. P4IJSa ‡U+[f9 endstream endobj 428 0 obj << /Length 189 /Filter /FlateDecode >> stream xڝ1 @EL70s @BBZZ( 9Z#XZ:IVt« 3Or#xjBN%7nt8SjImYǤ+]'RzΚT;l@TJ @ hxjze/ ]a;AdD/ak+?iTRS" }G@ endstream endobj 429 0 obj << /Length 188 /Filter /FlateDecode >> stream xڝ1 @EL/ :ͮA"EVbE$Nxg1q߄l">h.!Ǧ^OXRcR 7'e|ޏՌ5ٔs@ th~//iKxO`LГtIVx?>(=Cuڕ/@RriniMoEBs endstream endobj 430 0 obj << /Length 104 /Filter /FlateDecode >> stream x3230W0P0W52T02R03RH1*24(XCs< M=\ %E\N \. ц \. a0C \= h endstream endobj 431 0 obj << /Length 102 /Filter /FlateDecode >> stream x͎;@PggwAxJ!* %>Et300 UjrR豆iqA 5Tv̐ɩ p:_thq_h endstream endobj 432 0 obj << /Length 109 /Filter /FlateDecode >> stream x3230W0PaCs3CB.K 'r9yr+Xr{=}JJS ]  b<]d7zl+ -@>'W / endstream endobj 433 0 obj << /Length 130 /Filter /FlateDecode >> stream x-ɱ 0 g 2'0-k3:9 TGAEfڢ|7lXU:x@='e; m;P=fpq}kw+*\ǣҟ;ZFy2ddL*R!sBY ,P# endstream endobj 434 0 obj << /Length 131 /Filter /FlateDecode >> stream x-1 @E?^ xЙmV"RP:ٙ&Nwo\%红V\xA=y1:nwՇ Y/ t4M22DT&2+<*B# endstream endobj 435 0 obj << /Length 94 /Filter /FlateDecode >> stream x3230W0PaCsKCB.K &r9yr+Xr{O_T.}gC.}hCX.Oz 0X [\w endstream endobj 436 0 obj << /Length 153 /Filter /FlateDecode >> stream xڅ̽A ɉ̗eSH" ͣxwN5gvZ88Kb񀷲>7TzOoײC _.)k̓<j*zP R.NO|[ƧmdSL6e\6NdV;x* endstream endobj 437 0 obj << /Length 101 /Filter /FlateDecode >> stream x3230W0PaCsc3CB.K 'r9yr+Xr{=}JJS ]  b<]d7`= 1S'W fp" endstream endobj 438 0 obj << /Length 162 /Filter /FlateDecode >> stream xUA @7 u XJ0fԪEB ,jmAi"=xj1k)%g/ I|<$7}Mlx]I'$K>&ȔGȽm~i\ԅΏG8¢x8M lj0 b+12 endstream endobj 439 0 obj << /Length 94 /Filter /FlateDecode >> stream xM=@PEx$^!R { T߱4J2:*54`ƴ"f@BJJ7"i endstream endobj 440 0 obj << /Length 165 /Filter /FlateDecode >> stream x323P0P5T06V0P0PH1*2(Bs<Áj=\ %E\N \. ц \. 10703H01X010000$E@PPc0n`0\@r ;g0 endstream endobj 441 0 obj << /Length 91 /Filter /FlateDecode >> stream xڳ030Q0B#C c#cCB. # D"9ɓK?\ˆKCHx*r;8+r(D*ry(HL.WO@.' endstream endobj 442 0 obj << /Length 172 /Filter /FlateDecode >> stream x3134V0P0bSKCB.# I$r9yr+q{E=}JJS ]*c<]0A?  @CA2@5@D!dPICd \\\^ endstream endobj 443 0 obj << /Length 175 /Filter /FlateDecode >> stream x331Q0P0bScSKCB.S1s<L =\ %E\N @QhX.O g``~?`g N}`o`F¢0?Q\\\ endstream endobj 444 0 obj << /Length 154 /Filter /FlateDecode >> stream x3134V0P0bSKCB.# I$r9yr+q{E=}JJS ]*c<]0AI~ i"?P3@JR|Z0 @&\=) endstream endobj 445 0 obj << /Length 208 /Filter /FlateDecode >> stream xѱ@?Xf!FHJ"BJ--|1}_aau=΁egM]p,+qeL?&wXis)|›p1$Myƀv3|-{Pe!,GpPghFdPCWT-kCj( gf"{![ޗAftC endstream endobj 446 0 obj << /Length 330 /Filter /FlateDecode >> stream xe1K0 WbV hUw'AAAStp7?S>C>BG{I<J@MTY2Wn檜G>yv36sB<[B7^* kΛ[ojW^ar*Gɿ*ohȡYP~h)?_o``@t6J[LmS/t ]#zIm&+S %-% -3_P}Ҙw4&!YkC1R۠u㛥Ft(X@;x1lY1NN|1`'1:?%r endstream endobj 447 0 obj << /Length 185 /Filter /FlateDecode >> stream xڍ1 @ LMBVbv9Z#L!W0as_DhO-%CX턏ӆt2r@:兜YMz&cPpte] 0.,$+IJ_Fn_o^:, v;r endstream endobj 448 0 obj << /Length 235 /Filter /FlateDecode >> stream xmj1 ^=;Od-$AhO=Xބͣ{N"Q6>fB&?N'izmf4Z||DJƠz.rM/T%V~rEP@X8 \IU{3bY1Ez$'i=Sː†LBp6Pu 8:R [49޲&&Z'XΝ_%m endstream endobj 449 0 obj << /Length 209 /Filter /FlateDecode >> stream xڕ00#pO`Amd3ALd08Fgh< @ڴ_e4f, kӄqH2@5(xEB3 i3 5C8ZA/:L^pXpkFbIF2qUNCE>_c+vdn&~VP endstream endobj 450 0 obj << /Length 260 /Filter /FlateDecode >> stream xڭѱJ@? LaZ 4ܪ[-'BBRP̛*y+uvg!B#n;MG4Zly\Ѣ瞚-Sӟ-5#%_v^QdRPDZTRR OԵ@*(AWE],RIR57P&?2oƐ(~#FLg5=dF#zvL;mf&,mXJ[a # }R:%e-vvS=U:霾es endstream endobj 451 0 obj << /Length 194 /Filter /FlateDecode >> stream x3331V0PaS SsCB.S I$r9yr+p{E=}JJS ]  b<]Bc``D@.0L1S?UB7@`JJ=SP (<9P@=mrC%hAC!@ y`> stream xuб 0  /0 D4?/iLsqINƪ&v)9 O44FQ5o3j ioKk2 DdFLƤ1(C8^QDɰ|p1۽."byҀ)gk׿R?U~ endstream endobj 453 0 obj << /Length 166 /Filter /FlateDecode >> stream x353R0P0bSCSsCB.s I$r9yr+s{E=}JJS ]  b<]d `6`RAI68؀L2`%Hv0)"G'!P5Ⱥ AJ$ `G@%\=Mx endstream endobj 454 0 obj << /Length 254 /Filter /FlateDecode >> stream xڭѱJ@?l&yM"&`p` A+ :--7`kMg+ & XKf]{t\)pp{ =SuV=UvT]j__Z]>5(6S`-̗oնd IS03aLlB".!1Ox&pcJ&HۅrI)ܔ_,v0{ltT颧 endstream endobj 455 0 obj << /Length 125 /Filter /FlateDecode >> stream x333P0P0bSKSsCB.SS I$r9yr+r{E=}JJS ]  b<]?T b78) s)hb y.WO@.!7 endstream endobj 456 0 obj << /Length 106 /Filter /FlateDecode >> stream x3ԳT0P0aKSsCB.#3 I$r9yr+q{E=}JJS ]  b<]acW3v\ endstream endobj 457 0 obj << /Length 165 /Filter /FlateDecode >> stream x3133W0P0V5R0T05WH1*26 (ZBds<M=\ %E\N \. ц \. ?@"000=o`#?0o  0X0`ao`27Áq \\\` endstream endobj 458 0 obj << /Length 243 /Filter /FlateDecode >> stream x]J@Yr̡@&A[sjsɃxj= Qj(y=HДeDz~,//Ue7~_G8"Ǎ;ΟGΗoKWn6^D8I F"!:+2oa[87`d`+hLMfp&byiguf0~5jRryd* Sk_ N9Lxods-5P endstream endobj 459 0 obj << /Length 140 /Filter /FlateDecode >> stream x35ԳT0P0bKSsCB.S I$r9yr+r{E=}JJS ]  b<]d3 eR/i& 0 d`L?`@!\=Afl endstream endobj 460 0 obj << /Length 244 /Filter /FlateDecode >> stream xu?kP{<0p '% ur(vtـ]G|X#y=8. [~< 8:İ˵W|Ք.1wQ@jH>yo瘣1 ý 8hFx]*18yTB,a PM 2< fep\$I5+zG4VY5D NZ@fW'coQ! endstream endobj 461 0 obj << /Length 243 /Filter /FlateDecode >> stream xUпJ@/.0fMN?Sge!VjihkR\AKT֩$EuwM1f``w%=.>jRWRkRnKO/VSYZR7T@fm큼0 {düۘ=4]L3Ȧa@bli@T|`MLjb4L1dtFW$G *.|ؙtI6Dc endstream endobj 462 0 obj << /Length 239 /Filter /FlateDecode >> stream xڭ08#^@D'D::htGxWm~_LyxJsNgo(I5M7?/&~I#K CԼ*x1F%)dB 񑊅A8EjGU(Nk4, ~j}> stream x3535T0P0bS#SsCB.K I$r9yr+Xr{E=}JJS ]ry( , LS? 0adT Y;PCuP7 .ĵ'W K endstream endobj 464 0 obj << /Length 221 /Filter /FlateDecode >> stream xڕѽ 0𖂁#x/i*U ~I(}JK "&HrtF*8 q0Y Ȁf4  ״ 2o@.08BDu uf,HW lf(ze~ަ_Q@6+L6elZv,XKP~EԺe֩N=v< endstream endobj 465 0 obj << /Length 256 /Filter /FlateDecode >> stream xUϱN0 )K~h{=B @!Z̏F%Psw|J8êt0r^jE>U KWk=?ܻbuyJz_uEk?ƌ!fl#>3Z;@'7x &&ȖNm9R0!G/aEFD+E$ьMX^>a-M=:upǴ-i}GA^{sywָ+=# endstream endobj 466 0 obj << /Length 150 /Filter /FlateDecode >> stream x3Գ4W0P0bSsJ1*2" Fr.'~1PKW4K)YKE!P E?<@0g`A bP>T*L`)`J+F Hʃr Wr endstream endobj 467 0 obj << /Length 191 /Filter /FlateDecode >> stream x= @B\@7JL!he!Vj)h9G,Sl3X,fuVsmnFlzl @Hw4HH/I'S>[ِ҃C#^(>l \3X~ZPCAJ'BEH?4u7{-'ROr%xVݙ÷C qBszxa endstream endobj 468 0 obj << /Length 240 /Filter /FlateDecode >> stream xm1j0g1> stream xu1K0W v8b vtr@?')ΝCMHH^K^Y/PX.8\> stream x]AJ0CМ.8]ʅ҅&uW<3ѐ.OXSZ[svn Ik_> stream xαJAYL"y.p1bLBASP=p2E8n@,ofgɌKWR+s8 5srzJ 5W7Y ~k%vTZ^{cٳUoC0˖*STB`ζ&%EQ0b43e}"_馡}l endstream endobj 472 0 obj << /Length 232 /Filter /FlateDecode >> stream xU1J@/&Gw@B,āuSZY `-G#liv|ߋ`fȟiʓRuMϕK]ټOӺVEͅF6}8rBG g@p voDD,ZNE- -FI2vpeDZdbtkt`el6X"d=y<"W.;_t endstream endobj 473 0 obj << /Length 204 /Filter /FlateDecode >> stream xm; @ . Vf.1L!he!Vji(X({8Qښ}i<"Ńf{Qj{T3Qes:.{TŘ4 5E&6%/_x/PAP02g0yp&dBw:+0}ATyM6Ӣ5l.5iK|T endstream endobj 474 0 obj << /Length 198 /Filter /FlateDecode >> stream x3134V0P0R5T01V0PH1*21PASKLr.'~PKW4K)YKE!P ETD0S$00|`A; 00* ?8Q"I&PMb`߁q ̍:]'W ckA endstream endobj 475 0 obj << /Length 182 /Filter /FlateDecode >> stream xڍA `'?(   AZDjX.̣y҅Tcu 7f: 5P L % MBb%_/#jƒ&Ύ҄Z{Ue5TƩ-ՇW6j@-OӉ;*`{^[bTd7 wSZ= endstream endobj 476 0 obj << /Length 198 /Filter /FlateDecode >> stream x3134V0P0V5T01Q0PH1*21PASKLr.'~PKW4K)YKE!P ETz !HԱ` |P=iu D)ph<krF=A?0`> stream x]1 @\B/ 8M(+Tr!bI q23;9nvdC)lGUgwIBf6$32d@fr@&m)2ϩ\^sϵ2HQRQO5QJrh MTrL@V@ endstream endobj 478 0 obj << /Length 141 /Filter /FlateDecode >> stream x3236W0P0bcSKCB.# I$r9yr+Yp{E=}JJS ]*c<]70| C`003a`\=&[ endstream endobj 479 0 obj << /Length 237 /Filter /FlateDecode >> stream xڍJ1ƿ00 v^@9Å+T[}> stream x3134V0P0bS CB.C I$r9yr+r{E=}JJS. @-\. ?&iNa`D~700n?D䇁$7 \\\y endstream endobj 481 0 obj << /Length 122 /Filter /FlateDecode >> stream x3230W0P0aCS3CB.C I$r9yr+Zp{E=}JJS ]  b<]0@A@8~? q0\=(CE` endstream endobj 482 0 obj << /Length 150 /Filter /FlateDecode >> stream x3236W0P5Q54W0P05SH1*22 (s< =\ %E\N @QhX.O  P?`E6?gc?P~.WO@.W endstream endobj 483 0 obj << /Length 196 /Filter /FlateDecode >> stream xڵ1 @Еir3'p.#BBRPQr0E:? d37u.{ʧHrCqJzƁGz$15x2`ts [R?L3؂rkm;x3HKv@%.oԐ nn**ɍ@ÔDr endstream endobj 484 0 obj << /Length 108 /Filter /FlateDecode >> stream x3230W0P0aCS CB.C I$r9yr+Zp{E=}JJS ]  b<]?0! ̃`qzrrƂQ. endstream endobj 485 0 obj << /Length 177 /Filter /FlateDecode >> stream x33R0Pa3scsCB.3 I$r9yr+p{E=}JJS ]  b<]?`@=:773n? Da`N``` O7Nszrr#߈ endstream endobj 486 0 obj << /Length 147 /Filter /FlateDecode >> stream x3134V0P0bcsCB.C I$r9yr+r{E=}JJS. @-\. ?00`D~70n?D䇁$0I.WO@.e% endstream endobj 487 0 obj << /Length 188 /Filter /FlateDecode >> stream xڍ1@E #0e6 &naRK v9GTd)HN^f̦ǚ95(EqߜR{cRkI ? ldM*H&g8^WSQdHVR!J*- i~ nN/ookg$AH> wlzZIK endstream endobj 488 0 obj << /Length 196 /Filter /FlateDecode >> stream xڝα @ HByuj;:9::(>Zp"]qQ |CB?2ܓ1G!#I:Ramd$V$fO"tٓH$R^K6ʯ\UW0/%>T5*4hy~> stream x31ֳ0R0P0V54S01Q06WH1*21PAScTr.'~PKW4K)YKE!P E0a<|?`0?> stream x3635R0PacCcsCB.# I$r9yr+Yp{E=}JJS ]  b<]3P?n3 ~o0ah`?PszrrjF endstream endobj 491 0 obj << /Length 195 /Filter /FlateDecode >> stream x=αJ@Xf x{`TSwZ * W6`"8%Gf|q~K.4pR^j<> stream x363T0P0T5T0P05TH1*22 (Ads≮=\ %E\N \. ц \.   W  @ @,?(fQ 0pC sC3=;?f.WO@.uH endstream endobj 493 0 obj << /Length 153 /Filter /FlateDecode >> stream x3134V0P0R5T01Q06WH1*21 ([@ds<L =\ %E\N @QhX.O `J`pB`왏I@.WO@.1c endstream endobj 494 0 obj << /Length 183 /Filter /FlateDecode >> stream xU̱ P#k[WJ' rjj Ɔh>`Phj @ B\Q#HEldȗ$"Sg3:.{|LVkRj_ ..X ,g0i) <p&A=j|c(vk]b=(ԿOI |F? endstream endobj 495 0 obj << /Length 233 /Filter /FlateDecode >> stream xU=KPs Xxv(zb`A' Q|A7|~Lx`7UN?8g!Aj"z$r~nhdHڙdrO/$GcHN* WUP6Aߴ45q " bx%tq_cGŲh;L t5<fOk2|+ZlECd(IBY_ endstream endobj 496 0 obj << /Length 210 /Filter /FlateDecode >> stream xMν @ )(> stream xUj@Yi nZ$sSEGQ|x I;=F(N8^D!qiIs ǔB3I-1QYAg//74gZv* 0ÿ+]SCE@QsϰF,IqSn/'gCb^mmjg`1'>ڟK endstream endobj 498 0 obj << /Length 183 /Filter /FlateDecode >> stream x%1 @@$|'0+AA),DQI:IUuO)Fh~!;:c̐ېዬQ֑)HpIH]RY#H[m(l2Oe-?uC endstream endobj 499 0 obj << /Length 188 /Filter /FlateDecode >> stream xڵ1 @EH!L#d.ͺB` A+ RK EBbGRRl6Pt+ǬƬ5$Ii;Xf$#aI,Dv$f,I(K~ |[jWopG!SE /zO6x+ӸY~uд` endstream endobj 500 0 obj << /Length 121 /Filter /FlateDecode >> stream x3135R0P0bc3SSCB.# I$r9yr+Yp{E=}JJS ]  b<]0001; aX*6T?0'W N endstream endobj 501 0 obj << /Length 228 /Filter /FlateDecode >> stream xmαJ@o"0M^ป'pWSZY `eh>J+5E~;Yct_^iC-/+9u'Zst }{} ,, %s'l"aAZқMY'W Tc| endstream endobj 502 0 obj << /Length 235 /Filter /FlateDecode >> stream xu1N0ЉRX`3',ZiY$R AE GQr[0"OʌǓ/^ҟ+Vɾݭ%+yxb>F:iy-29Q EPE6fLV&b&e6fՎY (y/ifU _ cBԨM>y2_ |Ǜjh endstream endobj 503 0 obj << /Length 188 /Filter /FlateDecode >> stream xڕν @ + At-('𮶵kotrP?Q_ I+F!=ړ,o)$G$'KROt8oH&{$S^zVSBĢ iAf1h.p;`Z \2oߛy544` endstream endobj 504 0 obj << /Length 226 /Filter /FlateDecode >> stream xڕϿjAna s=b!j WJ!`R nGG8̜EH:_1;dySpnyΟ9)_6[d?9oR&[}";YL9#;e銊Һ„pQ*+j .+xs7xĕ\ }rR /:tKuNTc'ې'jiT2Dׂ+X endstream endobj 505 0 obj << /Length 243 /Filter /FlateDecode >> stream xmJ@O"p}dXW0 j)h()SDm>{uuVZjG+9}Mjag"VNbkx|JV+-*@ Ps&[ D>#E@rI~2> stream xڕα @ HB}Ѽ]`A'u(GQ|TZ?$w#3ihdȎhC!s8cТZp*Yz?WS2f5wHPQY 4a:B@ 8 1n -SQR-8 d_Ѯ+J_> stream xMJ@Eo[8м$AB`B]W҅E ;#Ǜ*y{wquLZZj}%OR7KmN~&wlֺ₲<>H\i%Jo*-o])L O[ `;d1a3X`LpM6{{xSHp|tO01l6 i4,e3zwgRS@v伕+c endstream endobj 508 0 obj << /Length 237 /Filter /FlateDecode >> stream xu1N0бRD@\lBTE"T AKr!e3 gi_'aE5tB 2(_pӢ&1^_v7T]M=[b.'0S2*(ٌ`&p B!t 灼__Rc%ɞ 6{6C!Ic)A?XZ1IN+OVqY- m9 endstream endobj 512 0 obj << /Length 192 /Filter /FlateDecode >> stream xڅ1PDPl Ċ1D+ cmq@IA;WL0 v xlagnEt4'g'Ty!n{> stream xڅO; Pl {I*L!he!Vj)h-G,-$q̃T;LNuihuɗV'/2O4Ĭxq7 $$M | ,G\W{F9^ـ"J[|rY"ֱ4nT?pGrjݬc_e*[M* endstream endobj 514 0 obj << /Length 167 /Filter /FlateDecode >> stream x313T0P0U0Q0T01SH1*26(%s<=\ %E\N \. ц \. L@$AD=$? ?@P&VV̌...SG;&.WO@.n= endstream endobj 515 0 obj << /Length 162 /Filter /FlateDecode >> stream x] 0->KNZ N⤎>cbMN8>] y GGbO%T2[0YFK&pOdLSAZZFHW 2"L}Tߩoﻭ "Іֺ? endstream endobj 516 0 obj << /Length 114 /Filter /FlateDecode >> stream x313T0P04W5W01T0PH1*22(Bs<=\ %E\N \. ц \. a`?r 5ez endstream endobj 517 0 obj << /Length 116 /Filter /FlateDecode >> stream x313T0P0V5W02W0PH1*22 (Bds<=\ %E\N \. ц \. c``pzrrlI endstream endobj 518 0 obj << /Length 152 /Filter /FlateDecode >> stream x313T0P0U5W0T0PH1*26 (Bds<=\ %E\N \. ц \.  @N5 D؁{! ?8$ &> F0Tta*`gr W: endstream endobj 519 0 obj << /Length 175 /Filter /FlateDecode >> stream xڵ 0DQXK'2҆  * D h%##6HWYM0p sf؜Tz2{XKf1)Kd*rdGR/RA-%a|ݠЂV$QoeUG+O;a endstream endobj 520 0 obj << /Length 171 /Filter /FlateDecode >> stream xڵ 0EQ  miCp  (0 i~ϧ{~37 <& ~9JϓJu }s7&xܟnKœ(4^Jq^.JNQr?)F#PQ1H)3R;;J~.؆xC?ZOYb endstream endobj 521 0 obj << /Length 104 /Filter /FlateDecode >> stream x313T0P0UеP0T5RH1*26 (A$s<≠=}JJS ]  b<]'W * endstream endobj 522 0 obj << /Length 113 /Filter /FlateDecode >> stream x313T0P04F F )\\@ IrW04 s{*r;8+E]zb<] P\=AQ@ endstream endobj 523 0 obj << /Length 171 /Filter /FlateDecode >> stream x313T0P0S0W0P01VH1*26(%s< =\ %E\N @QhX.OXǏ?1 ɁԀԂ2} pzrrxS endstream endobj 524 0 obj << /Length 116 /Filter /FlateDecode >> stream x313T0P0V0S01T01QH1*26E-ɹ\N\ \@Q.}O_T.}gC.}hCX.O A-4v@ ù\=emH endstream endobj 525 0 obj << /Length 136 /Filter /FlateDecode >> stream x313T0P04U54R0 R M F0\.'O.pC.}BIQi*S!BA,???PP'W ,5 endstream endobj 526 0 obj << /Length 99 /Filter /FlateDecode >> stream x313T0P04F )\\@$lIr p{IO_T.}g E!'EA0XAՓ+ ; endstream endobj 527 0 obj << /Length 157 /Filter /FlateDecode >> stream x313T0P0U5W0T0PH1*26 (Bds<=\ %E\N \. ц \. @#HD؁:Q'@&> f0d82>3 df Dpzrr@: endstream endobj 528 0 obj << /Length 107 /Filter /FlateDecode >> stream x313T0P04F f )\\@ IrW04 s{*r;8+E]zb<]:\={-= endstream endobj 529 0 obj << /Length 110 /Filter /FlateDecode >> stream x313T0P0V04S01T06QH1*26 (Z@ds<͹=\ %E\N \. ц \.  \\\A endstream endobj 530 0 obj << /Length 103 /Filter /FlateDecode >> stream x313T0P0W04S06W02TH1*2 (B$s<,=L=}JJS ]  b<]0 szrr$~ endstream endobj 531 0 obj << /Length 117 /Filter /FlateDecode >> stream x313T0PT02W06U05RH1*22 ()Lr.'~8PKLz*r;8+r(D*ry(01l;cNJ l r \+ endstream endobj 532 0 obj << /Length 251 /Filter /FlateDecode >> stream xڅJA'\!Ls ޱƅ+,J--;y4B[O"hWf,4s n,͡c%:IRc{l3yz|c;9?Tj fDTP&E{h+9G2D~>/BGE$E7~ }KvmV:$,H@%j}W}azH O#bA=b2~|0 endstream endobj 533 0 obj << /Length 263 /Filter /FlateDecode >> stream xuνJ@YRoyMry),J--$ba#*Āb8Gi+9/w]iF ftQ5 sʟjN\`v 1f!]b:ڣ5a&HzЃZ](&Dv) ZEֵ^mVvjRPkY-B4x1+ɛ>[OB:@|ӃFA:nKe4bڈq4Kmۘx~⃌ endstream endobj 534 0 obj << /Length 184 /Filter /FlateDecode >> stream xm=` .߁1D'㤎]ċ8p n #~$(}L> stream x}0K:#pO`i1NI4 Kd0FMj\ijx@½%\PPGL2P[2;|=7P~K<Ls 9y|9#l K#vӜ_[ZCN _CF,a8[NXTQ endstream endobj 536 0 obj << /Length 218 /Filter /FlateDecode >> stream xڝ1N@4QY AT (Ar 3AzWJ_kN|y9H/vI'Zun8-)\ؙBwoVWg)6r}Gݚ3J~ ZTMa.)- o̤/`tR27V֯ifhh`+-RN]dvg9 endstream endobj 537 0 obj << /Length 183 /Filter /FlateDecode >> stream x313T0P0bCSCCB.c I$r9yr+[p{E=}JJS|hCX.OD|?b0 AD}&> f0H0b!On%rv?s?>  `szrrǁG endstream endobj 538 0 obj << /Length 147 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \.    `|$lthvb)،6 Q .WO@.̌r endstream endobj 539 0 obj << /Length 145 /Filter /FlateDecode >> stream x313T0P0bCSCCB.c I$r9yr+[p{E=}JJS|hCX.OH" $`@CLmQD !( ,x endstream endobj 540 0 obj << /Length 120 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \. ?c4 N%'W  endstream endobj 541 0 obj << /Length 108 /Filter /FlateDecode >> stream x313T0P0bc SCCB.crAɹ\N\ \@Q.}O_T.}g E!P E >Փ+ HX~ endstream endobj 542 0 obj << /Length 156 /Filter /FlateDecode >> stream x313T0P0U5T0҆ )\\&@A "ɥ`l¥U()*Mw pV0wQ6T0tQ``HX`'$@DD?`AH?` @OjhPՓ+ UX endstream endobj 543 0 obj << /Length 123 /Filter /FlateDecode >> stream x313T0P0bCSCCB.cs I$r9yr+s{E=}JJS|hCX.OLŘN|? ?*f endstream endobj 544 0 obj << /Length 177 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \.  B`W${1y 01h͇q|Fa  l?`!'W , endstream endobj 545 0 obj << /Length 194 /Filter /FlateDecode >> stream xU-@%&c 迨 P$u[GEev K1h8&nL؃-;CFXA_>pi ?!&+R"c(ɉ(N+ƵGSroW\"Ϡ+tIߣmśh5| dXB]/qs| endstream endobj 546 0 obj << /Length 170 /Filter /FlateDecode >> stream xŐ1 @ERxt)R-n!he!VB9EqW7seϨxAƘxң3U5ݮr 쀾"h `,T'uID x/H 9 Zpqol endstream endobj 547 0 obj << /Length 174 /Filter /FlateDecode >> stream x313T0P0bSCCB.cs I$r9yr+s{E=}JJS|hCX.O0"370`H؃@`?#^^Q`Cƃ-Y  f $700 F"b\\\wN endstream endobj 548 0 obj << /Length 197 /Filter /FlateDecode >> stream xڕС0jrf{::"#a e0XvtmCOh)T^ aLiOvG ֤FscT,r0ʖSiNfEN`Y9Q3pqNN3O0n ZJ4&}5ty+A -ؼ+ԀW2>z endstream endobj 549 0 obj << /Length 236 /Filter /FlateDecode >> stream xu1N@ E"a|$H" * DH$*\!G2HQwmT 娔DJsՠg?x#Um<>r\Iq+wn˜24wC0MLNLtA 9a=tC68yF̛aO2/a<&E>oxv endstream endobj 550 0 obj << /Length 124 /Filter /FlateDecode >> stream x313T0P0b#SCCB.c HrW0r{*r;8+. ц \. @†H0 z(QՓ+ +T endstream endobj 551 0 obj << /Length 167 /Filter /FlateDecode >> stream x1@G(LtYY +D ,ZZhq@IaGhf'_Ϭgɂ#}SqblF.b27+e=Z3bÏB&.ْ`9:Rs)U*H]J^w¤%HRQC/~*hGo8 endstream endobj 552 0 obj << /Length 197 /Filter /FlateDecode >> stream xڍϯ P#)>tœ &5m.b_CYN wzto,NvE69Wh .-rZeD/@sL@56Mo%n} :}v%$@FTiXz[V!zyM-+_X=Ey>J3CN.{K endstream endobj 553 0 obj << /Length 226 /Filter /FlateDecode >> stream xE1n@б\ M<'m JHqT)"*L(iRZt)GLᏱEW23ɢ}ɟ\YV>>xUs&Ւg9pzy^Jz-NS={kg`g?EJEAJ>.dt &JI0r熻qM 5.M_f[݆{GZ>_?WKq{ endstream endobj 554 0 obj << /Length 182 /Filter /FlateDecode >> stream xڥϱ @ Y| j;:9::(}{{3!HŔĔ'tIio _Q[z>^WnEWtL(>a]Q3-c'4a|` BAI=EzNGKC8e  p&ȕ5 l endstream endobj 555 0 obj << /Length 191 /Filter /FlateDecode >> stream xm= @ x Ղ?` A+ RK E[)S,;h%Xfh< }:ex\T:8^pVQ>EmqF;)C}FE$ sXBט^Hȃ@?|bezYETZ_q-`R!a~K<.Kj/\ endstream endobj 556 0 obj << /Length 187 /Filter /FlateDecode >> stream xڝ= @g"#Xraˀ!N;GYg!BR@[]/w%ܔ|q&?,Lƹ+x"ҡ@yRx -0遍~*?umֽr!0e] EӐ`%Ж*sz endstream endobj 557 0 obj << /Length 182 /Filter /FlateDecode >> stream xڍ1 @EIk9 n!he!Vjihh%GL2Φօ}g?ofǜlS>'t#k5?;2{Zd܆L]rBC\"iJzD=[5/jLAOQ~ߏ@B_Zh4J5Ϋ^RMuZ9uEJ endstream endobj 558 0 obj << /Length 193 /Filter /FlateDecode >> stream xڕα@ .<} L &`qRG;[pqᾤ 5)+H+9s<^&|XLפ*L,r0S⺡MNMC $z11wx!"><Zi&N?>cH RaH'c ˁ:ѴmO, YK endstream endobj 559 0 obj << /Length 201 /Filter /FlateDecode >> stream xmPE4K BBrmM>}}V́;ܹiԥS=T'u9&a+NFF⻥OK+ VZ[( f#2;܃J>PDCv@Z }•cC 7'* 4u.7mp b2rcZI_ endstream endobj 560 0 obj << /Length 154 /Filter /FlateDecode >> stream x313T0P0asSCCB.c1s<=\ %E\N @BA,@Az H?*;&p4Aka[~ `1.WO@.^ endstream endobj 561 0 obj << /Length 253 /Filter /FlateDecode >> stream x}J@#E`}!k.p` A+ RK E#U(y[,gǰzqꜟJz`;볟 Z.(wk~x|ws%{/xv4lnfxYDdItSn\#7@efd=`El6X4jB*`f}E_h0bj1SL̀,x>v*!*:MƢ:?-y%ۧF@-7> endstream endobj 562 0 obj << /Length 161 /Filter /FlateDecode >> stream x313T0P0bcSCCB.1s<L =\ %E\N @B4Pe,B @d ?  B~oAd $?HzI8'W z endstream endobj 563 0 obj << /Length 132 /Filter /FlateDecode >> stream x313T0P0bcKS#CB.cC I$r9yr+r{E=}JJS. @-\.  @x@@?C1;}pA|.WO@.O) endstream endobj 564 0 obj << /Length 169 /Filter /FlateDecode >> stream x͏= @_#d.͟ B Fp !VbnxK q\`eW񊉣~2c!GOj .mO1dXV|-M -X endstream endobj 565 0 obj << /Length 198 /Filter /FlateDecode >> stream xڝ;@%$p.H)L0VjiVW(x[_~0E_cƃ=2b4gA ΄Sp)-8lsQy endstream endobj 566 0 obj << /Length 115 /Filter /FlateDecode >> stream x313T0P0b ebUel䃹 \.'O.pc.}(BIQi*Sm`Pz<7,{\W endstream endobj 567 0 obj << /Length 171 /Filter /FlateDecode >> stream xڽ= @[&G\@7!Q1#X^,7[n8ȃW3r9Al&]'-\,cx܎` s0 n ==Cbq1 SeKvI'mr/)T8R`5zf endstream endobj 568 0 obj << /Length 155 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O$$PD2`$ȃ@H&?:7 q.WO@.ll endstream endobj 569 0 obj << /Length 183 /Filter /FlateDecode >> stream x}=@XLvNBLH0XF[٣Q8ab^2}KJ)*%Kw4 +@@)juE]VQzB[_P :9o.A@9(dq%7@'a/=ߵG.^Tyh p A!\\[>P: endstream endobj 570 0 obj << /Length 200 /Filter /FlateDecode >> stream xڥ= @g fI"SZYZZ(ښͣ[.(wS|7q4HRYs_8 LWCNv?$#(%p:lHj&5pGٌs V,S*7;(&A]t, -GT@8=F> $_ȥF<5ޯ endstream endobj 571 0 obj << /Length 211 /Filter /FlateDecode >> stream xڭ= @ 4 وVVb&7J{ Lig Z 6_B޼q;QH1.#ܡ$ )ѯO-3 # ƒcM?n0O$!Wɾb|31P_6rilxz+=Տ>jO=]quBVŴ~[)D\|kse8'vG endstream endobj 572 0 obj << /Length 158 /Filter /FlateDecode >> stream xڭ1 @ПJuj!Fp A+ RKAEh9JAqc![̃I`4-ØԈmjw쎜{Vky\Y\/|9êe_Hx+5C8#$RC\B"xo<Iw endstream endobj 573 0 obj << /Length 185 /Filter /FlateDecode >> stream xM1 @4!s7q5@T0XErr,,2ԎgDM&rv=pr^ًYMyaoY!RrGB7 }KD#"eZSW!("PB Ca}96A=> stream x313T0P0bc 3CB.cS I$r9yr+r{E=}JJS ]  b<] @AH2`h AA~[@ Lx:B endstream endobj 575 0 obj << /Length 148 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O` $0()D? d=H2cģd> endstream endobj 576 0 obj << /Length 186 /Filter /FlateDecode >> stream x5= 0W:oN`B`A'qRGE7^̭ ء4ؔ? ,&Q@>0[}pb*Q)QzܟvI>>yG:J^]S |-,ZHZX:^<r[C准qzb&gaQ$L endstream endobj 577 0 obj << /Length 174 /Filter /FlateDecode >> stream x313T0P0bcc3CB.1s<L =\ %E\N @QhX.O `?aC00~ @2?Dv`N2~+ߎ #ȏߏ`` ?G#g``?A6 H@RՓ+ ɝm endstream endobj 578 0 obj << /Length 202 /Filter /FlateDecode >> stream xE; PEoH!LUBBBN!۲t @!L@,a̻{ې lfOÄܒZrɌOp>ܘW!kJ/LnRQ;H(+p{h/ O.ok> 44W&F&R$}xY& endstream endobj 579 0 obj << /Length 237 /Filter /FlateDecode >> stream xEαj@ dz)CB=ҩCɔdnvj:t&=$%p!:d-"zX!ZnhyxDQd}LKႲ)ֳ[{vȭ+OPy5 @U-G[;z[*lB;v\ɼHer;SHR Z88 ~Ka{ endstream endobj 580 0 obj << /Length 176 /Filter /FlateDecode >> stream x}1 P S2Y<9*BV N⤎G(Ϥc|?!?'S3>gt#͔+^wr~ÏB.9#W!H"Px+"B I / >i`$f_$hj(D{{-ӎ~b endstream endobj 581 0 obj << /Length 203 /Filter /FlateDecode >> stream xڝ= @_L#8MLRL!he!Vjih'({!q-6߲`}t!'<8 91 ũ piNfqJf)c2ot=̜w{@^m W÷x: dTLdO_'X`*w]!WҢqz9KU" }}d endstream endobj 582 0 obj << /Length 141 /Filter /FlateDecode >> stream x313T0Pac S#CB.# I$r9yr+Yp{E=}JJS ]  b<] X큸7001;j?0FJ endstream endobj 583 0 obj << /Length 222 /Filter /FlateDecode >> stream xe1N1E*i| .-V Ab $(UAݣ(>B,?kWEwk.i;O%/$=iI^>$nF6x0ڄʬ ͎X⌾T~fGvlgOȠ<|HTGǂ+ˇD5WTL3*=2,<8h endstream endobj 584 0 obj << /Length 226 /Filter /FlateDecode >> stream xEнN0 J^ @ZHHCL @>ZlDZTe}9W|Qps}ů}PYkP|N#5[ Sj~??ScNzDDFM&4=:4WL hLVښQ5A1;,wKi sęǐ dw;-y"ͧ\ۼ>[z3Vc4 endstream endobj 585 0 obj << /Length 181 /Filter /FlateDecode >> stream xڕ=@!$p. b&ZY+h pJLh$%^5Y (xTHN)74 U[QcL uMĄB9ƛG3a(if M( /#`cV2OZ˿Z;5t endstream endobj 586 0 obj << /Length 207 /Filter /FlateDecode >> stream xڥ= @4{t&)!BBB,xxqFE惝}ov)ZRGk;Sʱڬ)Nюe6aܠOi(Zb>$\Cǹ.5Tº)7 P \)'ߘ'-,e$9ґ i `AY ֚ G9-c endstream endobj 587 0 obj << /Length 241 /Filter /FlateDecode >> stream xm1N0E"4 @TE"Th+)S ͓=3uE5w|pWs/ 5gFGn{n5j+UknS=6@! `dHp糢0g0p \ύF<'"DMbLz[Zj6]*7DE??(jALP5ˠGԡ(OY*G@BR栛 5pI endstream endobj 588 0 obj << /Length 183 /Filter /FlateDecode >> stream xڕͽ 0+- h NB`A'qRGE(}zWEq _~3#)';#I~C"cQ8|Q iT5t] '`010%p1 iBt*Rt 2;nB)4_T+~Ѭ.:\M endstream endobj 589 0 obj << /Length 213 /Filter /FlateDecode >> stream x}O @`qM>!zI 0XɧSW؈p w3s3Y:'sÄ1P{~s8Ӵ$4'tcot=w {* (D`D:y#jAԠBQSQ]9h@9׆mƠ3/"-PIoәn ժ?|R3{6nR}Zn endstream endobj 590 0 obj << /Length 245 /Filter /FlateDecode >> stream xm1N@ Ema|HBbE"Tj`&GkH 4أnv+4rVISJ{!Orݢ~9^ꖋknR*.PI^((`)3Sژ1+-:%8p'?, \%ᔀ^ÊH"4)MP9%7Hi/! GdL!n&{| JMc_u|_!r endstream endobj 164 0 obj << /Type /ObjStm /N 100 /First 888 /Length 4093 /Filter /FlateDecode >> stream x[ێ$}Ao @y]2`P틡=YIn=Y6 2+% F2*Lp*9|ye4}Vfr)g$YV|G]P&YhU6"$Dp1aZـ!0q?'RB3HveLsҖYvg fqs=;euO^2XZVCXYuh-)A#eC@ [McJׂFc^ITNNpÂ2ǵZcYx|;c*'a5 IhIV་kb1 p Z6\vJcb@3/1rGY^6a @xܖD<UHHYz%сB"I<`9xlk2 Y0G(wԉE[(,2b &ʊIoR9 s&1DA!X\vi'g(OXQYW#pY01I{vŐh `D .W_~ܨjRdYjfa5asz5c9ZyWwwoް5jkw=k7w_=޴a󰹻WOӇ/fzzؠ 6wO xy͇sWuixxx\_ms\^aj!E m]iBx<5>c`۸lҗ_br^oq %3Nuގ mTdy[EY47W4}߾aM-$i˓MRf5؅G2j[N]Xsz6r}i}}ݢ)CZ0~7ygJ`p`Z` "փ.lAy{GwH8틥c q|×mXP_`amǎ0-3GXcX0ٞ1cyw.l28>g^ݶ>zacf4Z';6mHmHglC:d@%uBN{&v̺%YX,nK>ʋ.^X q E``$롈hv{ YmyN2?zz shu8\\2Xھ MNn)E 2Ap5A hc]Nk0b}w)rvk¬>$6c]rwvzN3}y1!-k,ڙ A.!-saK#; =_anO맇 àd,iVQH}/[$|>A$Q oo~?_o~~,!"5F[a[XpsG̀Ss<ֳ, } ,ldܷz\xBeY<`Y:dYn,s9qrc6/s h/p b^Ȭm~c386ic]o?uG]2s?cU/q%=wErx\*q%\8/=uGrA<@}5˅U0W braU4Gi54[BUjE /@w*5R;^nungPh5[0^ Fk o7Ǜyב{0aða= {0aòjsʺ,@aQj`P0s\ @L" u<\Ȍn D幏g:i!s򅂛 L6͓BxZ0jT aOfe-P? ~>?H3m̼N`5n~ qfLDӆ0թ|a0y 3߅PE<6Z*Z! `r-a9@F(@ƦTikc&ek Ja¶bC*-Jaj gP:+-J |*-@W6s~!/E_KA " ۊd(mPcpA3Nʒۦzz1UIFk>5S]oo._&ݩ;cS/uu'NN9:rۀr|(4}Lh rX.t@f&3 VTY}W{>tlc-悥^Q!! 7:?z< R$I0v%hr c(Br ie=5+tn͡IZ%gLJfqrF#g|gA p&vGhug 5ᴶκN;{M/N.-ԟ\ A{$'-nlWrj_9qF2y`Itbhwy"ee!31eHBT?Q6tf7mmuZ&(- t|q2rej?_zf.G_@Z M/˄j Z& CGٱ0d7 S_\ssBy7z)rxrWA9\wm{N;]X:*\KzjTJl;Y-hQPm*ҡz'7NB^JPka;A^z }}5?eK<л:.;?]͐y p>+on}3x.bR5h՜BrVJV?.Ҕcì;w]Aԧ+l7, Q6pv[Ë= 7_O&\4֕':کǠ7ҊO<4n#%)4GjDۆKm/M^X>ک|rŪB7ؽ'k5VdHWd Uc*5zYe[XR 0ߞaxw QjxRg1JCbƧhkFJԴ࡫1&l!&aHXC*pwj(P1@%~Ⱦ9!?tΛ; - /- - -thBЄС ѱCS! 1}hFLm/ۄ($o&ѼM;b6KlL6[lśM,P݌{nT46C&kcѰ ټ%5J'o% 8bWc0fƀf7:m -ы* O2NMեˆSrOt_Ӽ]K^gXcwly8;o)۱ݟ[xڎi}(ef7::eI>ݜݤQ:ZȲg[w\f0n5_ą)2'D(S][}g_ЪkK髾c*4)/խe,FC%;9PQUǰҒBC0r99ZB&ѫ!dAj}]C%A惪 HJ@7J-)ҁx߁xZ~@TJj~aJƑJBtKJ DRRT05qhI|> stream xڕ; PEoL  {? bSZYZZ(,-KRu)N8 ̜zOg4dL=j0&acH-dN*^r; W3֤"jvG t)P*ap2)\  <` %:5vQ9܆ \<.)ZFL Sl+ i":iҪK*c endstream endobj 596 0 obj << /Length 196 /Filter /FlateDecode >> stream xڕ= @F`&G\@7RBBB.ͣR j)jfk[ wi4{wdLN@#KjƐɜtٓ-ƬIMx9ِJ @,nBBPȁgXxn$aK?GTK%{,/"EJ5M--7Z endstream endobj 597 0 obj << /Length 143 /Filter /FlateDecode >> stream x3235V0P0W54S02R04VH1*24(YBs< M=\ %E\N \. ц \. ?`= ``  0>`> `r , endstream endobj 598 0 obj << /Length 102 /Filter /FlateDecode >> stream x3235V0P0b#CCcCB.C Hr=BIQi*S!BA,A'W !$ endstream endobj 599 0 obj << /Length 111 /Filter /FlateDecode >> stream x3235V0P0b#CcsCB.C HrW04r{*r;8+r(D*ry(7?P70`szrrD7 endstream endobj 600 0 obj << /Length 96 /Filter /FlateDecode >> stream x}+0DQ?4TI  (@" y!#9i isZE 7 E 0@bVHѕTHQi&Ċ)/=- endstream endobj 601 0 obj << /Length 256 /Filter /FlateDecode >> stream x}бN0[#[w7kѮ)5ڂ,HY1FuE1$̝`ڳ$] ciiǒM6jT%0`t)ߚڣ0R7 A\tdC@f;w75>/G% endstream endobj 602 0 obj << /Length 263 /Filter /FlateDecode >> stream xڽ=N@ !L"nCeHJ $GQr-7qF}#[9մgXsoSxmWt5Zx|Ö (ETV";Yepš{J9~P(eRXfdH- Xq*K8/~byoƃq?}`0fW';j#cͪy< ^ux߳= endstream endobj 603 0 obj << /Length 196 /Filter /FlateDecode >> stream x3732V0Pa3 SsCB.3 I$r9yr+p{E=}JJS ]  b<]@ ?p,B@@4#P2J@@hyt?iBAu?aa ?[@?P\\\2oə endstream endobj 604 0 obj << /Length 184 /Filter /FlateDecode >> stream x}б 0+-}'0t I옡ۤVr~>S hR(#^- &َ"lU"kgdfA!!)isޝKT oY<py~# ?@IzS=ZAh1s!o9)ʦ:#ǥ-~ endstream endobj 605 0 obj << /Length 159 /Filter /FlateDecode >> stream x333T0P0bS3SsCB.S# I$r9yr+q{E=}JJS ]  b<]CfPLC(~ŎB1PX ŀD@!;7UӀj (PEqzrrco endstream endobj 606 0 obj << /Length 101 /Filter /FlateDecode >> stream x3632T0P0aSsCB.crAɹ\N\ \@Q.}O_T.}gC.}h1\. 0 u'.WO@.y9 endstream endobj 607 0 obj << /Length 138 /Filter /FlateDecode >> stream x3531V0PaScSsCB.K I$r9yr+Xr{E=}JJS ]  b<]V0RP %B٣P?bP8(.WO@. endstream endobj 608 0 obj << /Length 253 /Filter /FlateDecode >> stream x}ұj0 {ʦIBPvP:;~~? &S !HIwWŜ :[U4߱I_6|> stream xeѽJ@YR#dM\p` A+ RK EAI|Sgwv/'W,fnQE4tuw8\/nqѢ=ܢmOjKvI@Ƽ U;=zŋ'|+|1#GR (2))RT58B )*B 0Dtc㈒(rTd<\B"!OLm%!) Yxnĺ endstream endobj 610 0 obj << /Length 249 /Filter /FlateDecode >> stream xڵ1N@EQ M#\* $\D*J(SAG\2 "J˻]>{m,|Dr!B~zóӥdȜ t$Pϊ˹vdW3V-pu/ Ɨ=:`Nzw8r,Vpڞݥxdn&8둉;b9޳0rEӪUXЂyjA^:'?ƿI endstream endobj 611 0 obj << /Length 165 /Filter /FlateDecode >> stream x333P0P0b3SsCB.S3 I$r9yr+q{E=}JJS ]  b<]A ?Q( 2%O&b Pk!: @'@q%vՓ+ 0( endstream endobj 612 0 obj << /Length 233 /Filter /FlateDecode >> stream xڥѽ 0->B4bۭAAAk(>BG3͇uP=AYځK]k̵p&˜Mgd ok|xp +@Z/0d73(M\5|3WU =e0> endstream endobj 613 0 obj << /Length 263 /Filter /FlateDecode >> stream xeϱN@ ?y/iJ"JȀD' X{hy^cꊙD5=:駓|_.(_ I4BCjz8nZ:76 endstream endobj 614 0 obj << /Length 152 /Filter /FlateDecode >> stream x3331V0Pa3cS3CB.SK I$r9yr+Zr{E=}JJS ]  b<]ANi Z@5`NWiffI3i04?(p\\\wG endstream endobj 615 0 obj << /Length 196 /Filter /FlateDecode >> stream x1P .^@?'ILtr0NG(сP[C_۴ˏ0$y4h CmJ9&#&5!d 4rJ>6>y[Rb\ [Bgpq Db 7 %Xz’+pC7 M=$qY+|T endstream endobj 616 0 obj << /Length 345 /Filter /FlateDecode >> stream xڍJ@ 97 hZ=yOуC1yCYrkKƙMEۃY?['j&(U\."pf r HT6ER秗{,/NT*NF+Z"(W랜;b#y6s"s>yGA9߹!yCacp^W$۝ࠥ; B9>׺vݱ ,)7?cyDSmL?h:3EXC7WΛ9i-ڛCyv,qZK yd endstream endobj 617 0 obj << /Length 199 /Filter /FlateDecode >> stream xuν 0+['0~I훙G#t =猪!ARG4!3vYW}؟pRP>@}vD?YM)C?mFAh0Wp(Ԇ&R_GWRM1|w5F ]5IW'C{p:V# \ 8.y endstream endobj 618 0 obj << /Length 191 /Filter /FlateDecode >> stream xڵϱ 0H- Lj3:9::(:O'dP{^CEĐ<%$Q`c^ c4 }p̀4]Pf*[1.h&GA}1t@%c55l)1(*zúg ?q[넭Da_=@M 4Bڐ3'`a`Ot턀 endstream endobj 619 0 obj << /Length 184 /Filter /FlateDecode >> stream xڕ; @ )Bnb*#X٣(9BKY#X[?MbJ]-(9ktRSZ*KJPUtH(>> stream xڵ= @FR2'p$!v-,J--o d3<6{A\Ƹ+ [΁Di,7P3P#eƸ֠5->E)tDL̔Z&U!˧m,Jy"LXI?嵏]&^-VgǞZn$̴ɦp h endstream endobj 621 0 obj << /Length 191 /Filter /FlateDecode >> stream x]ν 0S:w#>mб N(Q3 \'3ʇE)rF2:Rߥ}ה$S2{Z|)/&QR:tCuňC:DvG|iFyV;tPo07{KxN. P5 ҂5-Qle endstream endobj 622 0 obj << /Length 155 /Filter /FlateDecode >> stream x33P0P0a S CB.c I$r9yr+p{E=}JJS ]  b<]?000?FF1 b bҍXo5 endstream endobj 623 0 obj << /Length 264 /Filter /FlateDecode >> stream xڅN0 ]1Drop @ZUt`b81# xlB$7bBb"~??;㺧j|ƶoE]p3A{)~=\SvK;rJxP0w4{\ .c9N]"Yp&Zmm1B`XX 212sP)HrL51UW[$tUݒYņ'r endstream endobj 624 0 obj << /Length 157 /Filter /FlateDecode >> stream x3530U0P0bS#S CB. I$r9yr+Xp{E=}JJS ]  b<]3$;d%YH2$@A6W  H$r  WH endstream endobj 625 0 obj << /Length 122 /Filter /FlateDecode >> stream x3235V0Pa#SSKCB.#C I$r9yr+r{E=}JJS. @-\. 0!("3#! F#.WO@.Nq endstream endobj 626 0 obj << /Length 198 /Filter /FlateDecode >> stream xڵб 0J-}TZV Nj}G!̝:w'dfiYNf6\`w4=]/tbMf u~CQӈ*SKc;[ȩXeٰcF:ԋ!1H޿B !%ԉ=ۈec'l_ق0aOP endstream endobj 627 0 obj << /Length 105 /Filter /FlateDecode >> stream x3235V0Pa#3S CB.## I$r9yr+q{E=}JJS ]  b<]3GBqzrrW endstream endobj 628 0 obj << /Length 188 /Filter /FlateDecode >> stream x= ` C!GhN"  N(kyo =7:8pӺ.fϣRv39;6X|6|GB%%9 " 4Drr{EfV5 RגS^r_,IQiN[)%[y/ [> stream x3530U0P0bS#csCB. I$r9yr+Xp{E=}JJS ]  b<]1` g$m7>0`l@"$'W  endstream endobj 630 0 obj << /Length 176 /Filter /FlateDecode >> stream x3137U0P0bScsCB.C I$r9yr+r{E=}JJS. @-\. 000$700cA2 \ i$ ?l 4b>.d!p!dr~$_\\\-in endstream endobj 631 0 obj << /Length 193 /Filter /FlateDecode >> stream xڭп0$ h[I;`A3>#02+hMK`#8c1qgaSQH-1A9O=t1A*õA]OPöJAy)Ir&~mk]{77xܿf}N$nC&L-, endstream endobj 632 0 obj << /Length 144 /Filter /FlateDecode >> stream x336V0P0bcsJ1*26" \.'O.pc.}(BIQi*S!BA,? DM}?`@8P$` 4'Apzrr8W endstream endobj 633 0 obj << /Length 187 /Filter /FlateDecode >> stream x%= P7.BBBQy[Hθb2+$+]n: 2/*NrN7rZmx]9]bJV9q*> stream x3634Q0P0bc#ScCB.#K I$r9yr+Yr{E=}JJS ]  b<]0<z @?bT 7~`@400cr pR endstream endobj 635 0 obj << /Length 149 /Filter /FlateDecode >> stream x3530U0P0bS#csCB. I$r9yr+Xp{E=}JJS ]  b<]30??@5J2"0?;lA*r  endstream endobj 636 0 obj << /Length 199 /Filter /FlateDecode >> stream xe̱@7&`8ɚ( BX+ RK EBɧ"8qaZ=y$/$I+w良`=,g+b*qz;D$K.&Q~8-x)؇% Vd.hUAmP[0+|D0|D] zy^֐}bUc\6??#Zh endstream endobj 637 0 obj << /Length 236 /Filter /FlateDecode >> stream xuαJ@9R,Lop'p=pSZY՝pE h({]#ZFcf˳朻Em%a⹐QWthMB{[ݝx|A6%ڭy*M\K&#d!#POI* MD // R2h``R̓m\Ջz=@>6m8}F}:1Μ> ,Ef]O sSq0iTxj endstream endobj 638 0 obj << /Length 214 /Filter /FlateDecode >> stream xeͱj@ `-~&lpB2eڌZ-?&A 㤻_*2zSbI_9`QJithwThE}鈶ټS}Nal}!!xH˘ K{0S%YLI4^½vA:C52?j,Tk؄pg e3D^63U[}l* endstream endobj 639 0 obj << /Length 245 /Filter /FlateDecode >> stream xeϱJ@YR &^SZYZZ( W$/%E[nnY|,3[%t@{!4?dS5}{e ݹ5nyyJb"fo87a L{kqEoڛA IsLlL;q6,)"pk'a 6jTvMt%yp7c%^ +~o endstream endobj 640 0 obj << /Length 200 /Filter /FlateDecode >> stream xM? 0_PxKwڂb?`A'qRGE-G;.@^W E)9)+akx8^hVq^YɔLq&39#}遪{G-m,@{L? y㉲C| uj%@* y RMTrR)~I;Ri+&PڦeE[fN endstream endobj 641 0 obj << /Length 188 /Filter /FlateDecode >> stream xڵб 0+-} hP:j3:9SutPt(}Jc quːOTSLf"(I1i_3Ŏ ʍQ5ݮb $,Dm`XP?䯰a"G H述[%=Ρi۸{}9s \#G endstream endobj 642 0 obj << /Length 122 /Filter /FlateDecode >> stream x3137U0P0bCSCB.cc I$r9yr+s{E=}JJS ]  b<]DbvQ$G%AÈB\ endstream endobj 643 0 obj << /Length 231 /Filter /FlateDecode >> stream xmJ0,%Z%c7!02I|zGƭVx|,͝Gif4ۛ IodyA# ՌJ&E8]&Rj Ф KX"9߰C"N +oq @F2h.pFmLF IA.gOլ endstream endobj 644 0 obj << /Length 237 /Filter /FlateDecode >> stream x}J@ba> stream xڕϱ @  Y6O`[ҥTAAAQPG#ttt $Byp :D%;摤8ߨ0XnlBuحVK>/'2%;%|AtG*A0`/PuF199a{Db#j3X5SS imhO_o`{ endstream endobj 646 0 obj << /Length 229 /Filter /FlateDecode >> stream xڅϱN@ `G"yh_p([+"5:T #^%pcHe``\wm# i䶔߸jQD^yݱKղߢ̾{{)oPFn(F ѩjd|L@6mБT /刏sg`|8c¨5 M◔i\Qn+ yrevEsᇎw 4s endstream endobj 647 0 obj << /Length 235 /Filter /FlateDecode >> stream xu=N0M#x.NV[YZHPQ *Ap%G0EagY<]6\瓚CMϴXiXq~hݒŊ܅K~}y{$:܆ok0`2Rӗr@IrBGbd2lRV;xF!#SIgk4IY;!Gabݸi^aeb_Ȼ+:(4 endstream endobj 648 0 obj << /Length 237 /Filter /FlateDecode >> stream xm1N@o4s؊R $(UA WM#šapJ]_;勆ۖzƆ5wdJ۞^m1U-P↪?6\?Qc i&d r2!.G?pS8|9]'?XPT)L%[2/jNl>9ے5FX = WUUG@~U햎 endstream endobj 652 0 obj << /Length 338 /Filter /FlateDecode >> stream x͓?N@gC6QڸHaRK vF8%^0 Z-;;3|qvrXЧhsJL6~Em*iS^o*\R[}OT@WdR;Ȉ,QG9Ci 7rXK0A@$s;:>GOÔ11PVGG { r(ܑ  J}1*7S($;SheIL>oC^fi0ӤIΧ C4qHGnJ谬cC +{7Z۶> ࿢*E!en/ endstream endobj 653 0 obj << /Length 258 /Filter /FlateDecode >> stream x1n0` x'b R"5SS۱Cd(9BFcWGRZ}l_Y1S#=e}EeEzYNzm6|<>I/O^捪ko?n>CK(I֪ov^سs`'rVr\w I˼ދ/np=g?;ؗ= 13rً E7Z1ӌk kmgj.=WMs endstream endobj 654 0 obj << /Length 228 /Filter /FlateDecode >> stream xڕ= t y G('v3#NI4:(IӾH~iՍE[LK;nc<`gq\$A95(8;H(beYc6,wh*.9)"1RH HP+whyś(/*P#qRDҥLSc_擽P[+^& I)Jt*Jl)sŪJSN2\U\ endstream endobj 655 0 obj << /Length 105 /Filter /FlateDecode >> stream x331Q0P0bS #CB.C I$r9yr+r{E=}JJS. @-\. A(9TH:հ endstream endobj 656 0 obj << /Length 290 /Filter /FlateDecode >> stream xڵӱN `H&GJkNM3NIM{4"Rȍ%) ~ٜoK<+>Lcuz^aہxĦqkAtwb{%>X> stream xڳ431W0P0b 3 CCB. rAɹ\N\ \@Q.}O_T.}g E!P E?!u?3bSWbWbWa1gXu0V6V eG,eƒ'c1%r C< endstream endobj 658 0 obj << /Length 233 /Filter /FlateDecode >> stream x퓱 @ S:Y|]I(>BGLZD''|r7Ѧ;M CA> 0Ym՜՘eTфU8A5!hHpɾe PVr{y%رW Kp,+&uaJNEIM4y0犉%ޭ^ AlH4ȗ6eOE8`| endstream endobj 659 0 obj << /Length 270 /Filter /FlateDecode >> stream xڕJ@'LsL 'BB> stream xڵN0/`?BdS` Heꀘh XI-#d`stgۿ~Iy)x 5_XQ&oG\7vWEF<z{O5 Tb!ȣO!2J`@;PP<;Gg3E9c̈*l09t / inm';)),bߘ^Jq݂zlgF endstream endobj 661 0 obj << /Length 253 /Filter /FlateDecode >> stream xҽN0T"GȽu~n! & 7+Q!ʟĄd嗋l4\jU<sMo4HQ {N^Kls/dKɮꑚgʱw_ s=$p8E . (sׅ42*ȱ| ]6&ܴLpڋ_IHGN!X>] 7#f".F?^Q 3ҙ b= endstream endobj 662 0 obj << /Length 244 /Filter /FlateDecode >> stream xڅJ1g"0M!`Dy[ZYZZ(ںy}<•aǙP1|?IO :1H=>cTPc;Ocw!^_[^ʙ;V8?dmgPj\Rq :dĄ* |Vbn;gE d1o( ؁ahDBc!D[o1En %in6N:\Z` æ]H_I<?y뭜 endstream endobj 663 0 obj << /Length 175 /Filter /FlateDecode >> stream xн 0>B L*)j3:9vtPtnG#8f:M|~3z> stream xڥ?J@'X&G\@HBL!he!RK E֛L2ɮ9o[,Ƴw565>UU7v1.tqoYKtq ˣ|QђCDF"RcB|&;J e%wpU3B?O|G(^'f ]THد|X9/O8E.> stream x373P0P0bsC cCB.33 I$r9yr+q{E=}JJS ]  b<]0$0a aÐef0x:`P?H e00?C(v q'W l2 endstream endobj 666 0 obj << /Length 138 /Filter /FlateDecode >> stream x3635Q0Pacc CB.# I$r9yr+Yp{E=}JJS ]  b<]``0f+ɃԂ 0a@\\\٥; endstream endobj 667 0 obj << /Length 243 /Filter /FlateDecode >> stream xѱJ@)nMD BzQ|-#w_Z˷euG|]KkhFrw[r??ܓ[]rKn7-74B,? X -,fXNpMV%\{`r_ |7fZlP \X~r['-pG NZpZY̊4_HWn$ endstream endobj 668 0 obj << /Length 107 /Filter /FlateDecode >> stream x3635Q0Pac cCB.#K I$r9yr+Yr{E=}JJS ]  b<]0a\= endstream endobj 669 0 obj << /Length 232 /Filter /FlateDecode >> stream xҽjA W#>WZL+vrp!ET+ -vXqt;';됱j-->xsiNY-gOّy+#CYEI O$Rx%4DJʤn ׮UH@Y$߸Np⧤D@(Ax^ 9Eۄip xviC endstream endobj 670 0 obj << /Length 184 /Filter /FlateDecode >> stream xѱ@ & &]xHLtr0NUy{ጃ zw6d4JBGqlfiG{1+P)QEz@-ibc|!Pi ౮!`{.TV6ߡA_y48+po endstream endobj 671 0 obj << /Length 231 /Filter /FlateDecode >> stream xڵ0kHnЂ0 &2`A3<#02^KL%!_s{I!.qa@CT9 +@P% 7 v+@x0> stream x͒N@ ]uG_.!MBH 02<Gx۹F:.˓"J:lN錞c|,5<WO(m(KѭEGWbtK=b$(#!@5@oJ 4{aŌfJ`o}4.lO%wm_mte4](z`_TU` endstream endobj 673 0 obj << /Length 169 /Filter /FlateDecode >> stream x;0 t#' VbTD$02`nQzT dj20XY陞c+4xRps?aq@iA W<ix=   E^6ɱC:_:Wѫ}O_ /h m Ij^ endstream endobj 674 0 obj << /Length 259 /Filter /FlateDecode >> stream x]1N@4;ۊB$\ Q%ڬ\vY)yTk.拊57 UIJ/Kn6O\k*ybx[~|nXp8HDF#々~7'QȔ^;LKZ+45qj@.dtv!"ieh֔j]dV絳Su ?hgcfKxhGZ endstream endobj 675 0 obj << /Length 186 /Filter /FlateDecode >> stream x3534S0P0R5T01Q07SH1*21 (Cds<L =\ %E\N @QhX.OON2bH$;&=A$3?8HAN7PJ`$H `( E` qzrr:p endstream endobj 676 0 obj << /Length 187 /Filter /FlateDecode >> stream x1 @   fl1[ZYZZ(Zkyt {O!(VhpZ0(j. 匴F91J3FNPf4W.dI K#ZX+ސ8 w6 .n N<sUv848n endstream endobj 677 0 obj << /Length 252 /Filter /FlateDecode >> stream xڅбJ@YR#d^@7l 'BB+RgvE8X>Y؟/Η%YJyN^RaaB> stream xڕ1j@7Xx6l6@RXR%)S$$fB.2Ni!7.V?u~f*U+uW9o(fKUn*< ݖIu>?_dRLjG/zV!C؃@p` 'h'đv3k"t{O<8 F evb883MmH Є̎io“z>Ba"0i5s?hb8T0c00c*Cٻ1 i<8^gvJpi\DXו!) endstream endobj 679 0 obj << /Length 270 /Filter /FlateDecode >> stream xڅN@EPL'~ >X<&ZY+h+| K$\gfX){ʪߗu%B-k_Weʡ/ϯ7/nyS壼'7e"0қ0Dr92DI-٨l+s@!٘b4Hfoq!C?I?b`6|tC t} lLD2r1uIU'TuIk*T%5P%5!.>Z/1 endstream endobj 680 0 obj << /Length 232 /Filter /FlateDecode >> stream xm1j@*x-"cUZp@R)b.X:#T!vRYH ~Y7zVƷY v_ԿQ[ݓ;N{{W߹ʭ޵۹[J0)\$x " LY$> LQ~ 3 afˈLXF,@' .L h22#戜#䑁rm\-jhp endstream endobj 681 0 obj << /Length 137 /Filter /FlateDecode >> stream x3337W0P04  )\\&f  ,ɥ`bƥU()*Mw pV0wQ6T0tQ```c;0D0I~0Y"I ?&D(I"\=VI endstream endobj 682 0 obj << /Length 301 /Filter /FlateDecode >> stream x}MJ0)YؖG_]x>.]W҅h=Je? گiftߟ ChÞ6 s/\knCs%ux^ߟ\s>k o@B,D'DdZ"-,-B/63"x甙k p7q|$pF暿 dL@AvZHFӬYM5k|,ZdIeb4j`Mg!@Tt`[Bͻ.A8Ew̕bԊW'bt7}t endstream endobj 683 0 obj << /Length 305 /Filter /FlateDecode >> stream xڍN@LJlA gEr&ZY+h=> @IA烋 |gf.K xQz!eY^#[E{_o8_c#>UX>)EৣNGG#"qhfH8fEAEI=-Β%$#쵂H\Wfä hgcgݺi8iZG`s+,25\i`2[[E3)D/bZ1.8G IUuuR:X&oݴ]֯"Mߴo endstream endobj 684 0 obj << /Length 225 /Filter /FlateDecode >> stream xڽнj0 ['Pt!tP2;4qh~?G$C@Bw&,+]po1}R28^~в$IF~{͒/wu|'ܯ8&旘knLM@;&ED-tw>5 pU/jh:؊,PW+D5^ԝhma#:YVp=Dӊb~9ag/uwiS]]q endstream endobj 685 0 obj << /Length 285 /Filter /FlateDecode >> stream xڭѽJ@Y lGȼ&H +PN-`bu>r"X?L6']x\c[awO}͚L> stream xڍ=N0'’!sHRd E"T ()@ Qa-G#LyxcOx~ar Լ=>٦fqR57-ϱm__l<ږ[Od%2 9SQvTy2S T 2NXFvY _C!"%R/Q("!V$M x#$0"W ΈPr($7y?"^\%Id^EARiP7@t4F}ҷ CGɞ~\ endstream endobj 690 0 obj << /Length 136 /Filter /FlateDecode >> stream x323P0PP5T02P04PH1*24(YBs< =\ %E\N @QhX.O9   fv6> $'W  ' endstream endobj 691 0 obj << /Length 95 /Filter /FlateDecode >> stream x323P0PaCKCCB. \.'O.p KLz*r;8+r(D*ry(177? 'W  endstream endobj 692 0 obj << /Length 193 /Filter /FlateDecode >> stream xѱ 0_:n#xO`Rd@+AAA(}j]Arnc6ܗ<2|Lڇ) džBnIK^nGՌ# o#6;JN-(_)/|bAU+V]U"sbh9RI+[9hJm+܇Ͽi&c|/?yJkzo endstream endobj 693 0 obj << /Length 257 /Filter /FlateDecode >> stream xuбj0d=A-pHRB;u(@19G#d`d |' 󟖋;}O5\RQ`ȻO}c~[zIc%a,D!Q$mbG2bWh*^jL/.i AjS]3}`qd;<z<ĠuH> stream x1 @ [~/1FJL!he!Vjuh%GL7pWjRVsȣ BRJœϲ?SVp\ؚdq$fyQ3ƴ_@ x6QjykaD D~:Vht%7Tm endstream endobj 695 0 obj << /Length 258 /Filter /FlateDecode >> stream x}J1 ] {-(tdibVp> stream xڥҽj0p [hd`e3$)C 2@!!G3U?& w0 ,N=j7>FTҿUx4F=E_%\ᵀ=/ɸh endstream endobj 697 0 obj << /Length 210 /Filter /FlateDecode >> stream xҽ 0+!vuФZj? N⤎nBh>PWj#:,{)=F(c[eZJ *8~91d plp/ër endstream endobj 698 0 obj << /Length 229 /Filter /FlateDecode >> stream xuϱJAba yh+RPK E;1 tƽpS|?;?xžjs3TC=-r+SrgkkrKyrM͒a{ծlB-`a:`u)xuwGW2&e˯ɦnh huaǨk} [ bԪob"EzONoɌla endstream endobj 699 0 obj << /Length 203 /Filter /FlateDecode >> stream xڝ 0OKдv vtrAPGAEA0G#8:ANȹ-Lp;"dJ Z_V[UglJ#IWc>NҽIs-0pu@܀_x vZհu/{#ҡ^EA^UzN4 E A2;Wa V4'VhLr endstream endobj 700 0 obj << /Length 210 /Filter /FlateDecode >> stream xu1j0g<7 41'z(S$ MHXGQ|JW\(T 7uN3uki1}.Gq%Cf&u#U])Yϧz\R׹fi WOp_PI! I@*#f%#~,K{ǏT#,ΰq`(nYsLޖF^V2 endstream endobj 701 0 obj << /Length 167 /Filter /FlateDecode >> stream xα @ ;:'zx: 7:9: *:{G;s]!3pck8YǸh PsNA^/r9E l BuL[VeTɎdÞ@`_wV| 䈚 oafaosK endstream endobj 702 0 obj << /Length 125 /Filter /FlateDecode >> stream x323P0P0b#S3sCB.#C I$r9yr+r{E=}JJS. @-\. ? :  .WO@.P endstream endobj 703 0 obj << /Length 110 /Filter /FlateDecode >> stream x323P0P0b#S3KCB.#C I$r9yr+r{E=}JJS. @-\. ? C 1cqzrrp^ endstream endobj 704 0 obj << /Length 159 /Filter /FlateDecode >> stream x3534W0P0bSCCB. HrW01r{*r;8+r(D*ry(0a@R` `$@z ɀ a/ m?C&\=?qjS endstream endobj 705 0 obj << /Length 209 /Filter /FlateDecode >> stream xڝ= @GR2MtbSZYZZ(ډr2EH|((v̛ݝGa_ endstream endobj 706 0 obj << /Length 144 /Filter /FlateDecode >> stream x36׳4R0P0a3CB.c HrW06r{*r;8+r(D*ry(0`?l(g?6g u@lC{ pP endstream endobj 707 0 obj << /Length 213 /Filter /FlateDecode >> stream xMͱN@б\DTd""R.HE) h!kfg:[\ꗺXS)Ks"Z;׌oY2=7Ro0ͬ&a8YZi4 %:1X[z83L̺E[y!8}?+O2dWtm8 \\ղuY endstream endobj 708 0 obj << /Length 162 /Filter /FlateDecode >> stream x1 @ᷤL fqC@Vb--+'Gˑ<@Ⱥ!X l3pjZ>DŽm:L#c^[z?.6 6KNJV- -reByDz 7U}`(D,uxI0nҷWR hhKob endstream endobj 709 0 obj << /Length 248 /Filter /FlateDecode >> stream xeпJ@o \`^By]  @-G̣R^w]9 Opj8>xPS5ZOLIppu%?^^qDzŷ;JW\ׅˡ~ lr&Vg{'´N2;s8Gvn=ЪQob]pл ~^8:g007~ʞJT Ͼ4sM^!yJ[X' endstream endobj 710 0 obj << /Length 207 /Filter /FlateDecode >> stream xڽ P FҡмVn?`A'qRGE7f}>BŚނ*3$|9VuQۀ}+5͞1%kTڤ|18Ux*%V738 \A&rOP deyܿ>X ?c\%#'q(IfNĴ) endstream endobj 711 0 obj << /Length 131 /Filter /FlateDecode >> stream x337U0PbC33CB.c# I$r9yr+q{E=}JJS ]  b<] >00013 A9 CaՓ+ t^@ endstream endobj 712 0 obj << /Length 259 /Filter /FlateDecode >> stream x]J@Of!"." E0pA.Z v |˝gH0??pNNmnҮwYUϹ勧7wk"nssa q[{_AꭅBaD4%;>#p{%*édlW]HO˷df 3ÂױtK҇FoMfl=o,"E"pLΉ~WhFF*4& !3DWZnvj endstream endobj 713 0 obj << /Length 285 /Filter /FlateDecode >> stream xmN0Fȃ%/~/IQ:F*E"02@bH͏GȘ!s[uY:9˅/|.|U_ݔOZ~̺1/ 2l~||}&ǹ/L'bFzNEؠtX !v$tS2WSK8Zdef-UwN: VBDXMvU=+OD6($8ㇸb+N==BZ!r5B<$gVZ}F=sӘ{~ endstream endobj 717 0 obj << /Length 123 /Filter /FlateDecode >> stream x31V0P04F f& )\\@ IrW0 s{*r;8+r(D*ry(0~` C@L. \\\[^ endstream endobj 718 0 obj << /Length 245 /Filter /FlateDecode >> stream xڝj1 9沏y ݋k{쩇ғAћ=H؃߲CL`-lo =|oK.aN<|-dT^mlFmٌWcoqn> HɁX 98;[e"D}禇Mw,,#V j su몄=]}cSY}]w`O` V ~֖༶_%j~ endstream endobj 719 0 obj << /Length 405 /Filter /FlateDecode >> stream x}=NPLJPwlV$HaRK ֏xQ8³Äw>7kU:YӍR=TYl-{?]#ފE\חGQT%Ty'"" D%ВdЀ(0Z@5QVD5Ǡ}۱(et"+Fr$ ; BI~鞜1PW!)fh=h۩﨏5`"!&7]kJZ.Yo'd-&$c%4>Cf~Ml3EHL1f XB ].֗0IAYeUÆ1:iCH_²Sq#F mnw',ڻ)8oĵkc endstream endobj 720 0 obj << /Length 192 /Filter /FlateDecode >> stream xԱ P# YztT\`955DS56Ih>JxUZG`/Wp€zeX]'d =dE,zE d1m&19XZHKնo ㇒xdflw4u VP|u+Ӿ0xZA7\a^J( endstream endobj 721 0 obj << /Length 283 /Filter /FlateDecode >> stream x퓱N@ e%ʝNX*E"L @0< y{{iZQAɿo>%Ct`inCp&YvwsKM1;a8?>^ҕ%s`Ko F*MwR*^nJom[w)}KDJXĢȾUAB֫~o)2PAշ%{Sh7ԃ]nۅ߶> stream xڍj0 e2hCI PhS۱CCZJf endstream endobj 723 0 obj << /Length 146 /Filter /FlateDecode >> stream x31V0P0bcKCCCB.cb%r9yr+p{=}JJS|hCX.O ?D PB1X/y`i؁A0za?J.WO@.3 endstream endobj 724 0 obj << /Length 111 /Filter /FlateDecode >> stream x31V0P0aCCB.cSJrW06 s{*r;8+r(D*ry(0o`&A(1` r .s endstream endobj 725 0 obj << /Length 258 /Filter /FlateDecode >> stream xӿJ@+ }s8@88O0X`e,,ME}I @Xabfn?w^ͧ{]]"kvfř{~zlu~]+\kv2HɎY@КѩY`;zjeRZ58J$}¤A/yB$Uީ>?ï~_8zѝn7wEf7a9j=)BVM endstream endobj 726 0 obj << /Length 198 /Filter /FlateDecode >> stream xұ @ ДBE j;:9: * nS:vc!K.!K| %)E!֒639-ij)UT US*]@cfWl:%uW+~Ž> stream xѽ 0-y'06 ftr'uTܚGQ;祝\݃~ +0.0xH:: eOPZPwA%ޮ#r5 )&;3D"Z*rLD^cj&Uؑˈ^t;;jUxa|t-?>W`na o? endstream endobj 728 0 obj << /Length 296 /Filter /FlateDecode >> stream x]1N0E"\)sHR4HE"TjA-G\0hŒO?h,5yK%k5k(2Uof7Էrm>?^M{zjy6Þ1 (+bv`柀UJ"~# N>t%%1!*0jQAzj:ޖ> stream x= @ )2(I#XQr)uv! jc_13{b-lHlH\J@2$]kH)F1!AtG "Ù`*Coz_kjSӵrgFOT&.Y<,I(d&t^Pkԏ-b0P0+f endstream endobj 730 0 obj << /Length 319 /Filter /FlateDecode >> stream xڍ=N0F'Jɍ$,-D $(KI:(VnrR2|Ю%[o쌟f]s֚ڜcjsyazSۓ<}Ӷ[ݕiTu0Tw01T4"LBG `"'$$PƌDPiMB A-BsT'!Q(+Β[>5PK9NT> endobj 594 0 obj << /Type /ObjStm /N 55 /First 473 /Length 3258 /Filter /FlateDecode >> stream xZߏ~_\sHF'nIl-rV)}!䬴FVK 㐜ofu![UN *2d"Iu|c7^QʑOIeopm01!MPF `4AHt&{3FİIzc cylV[ I@cט`]A0~6*c a*V6$EU!J]pf nʞ x~';&zV"edvu>@Xqٳ};پaw{T?:-\NpzH8zzx{1X|0|#>y{        k3F&H4z 㳏MR>1nnnE zSsZ>x |1||q|| |!D$a 5 k0aXða 5,kX3v4lx⋲i)p\8*)# ^ן` Z''[C( D;Z#rh M v}H(6~HUH~HHHmhĨs䆭&F"5x9BTZpl_X6o37E40j7U/QF}XXg,{<`zLm_=^۾z~ݗW>6ooscIiʌܦ,Xy?8a-ML8 '8)Wݥvⵦ4aM kLpU."rx 'N} _)L%,űMD,i*{Cix;qXny®k@Г1O<$E(r|8wtF^e I Btɒ%%?GO%?)PJtƯBqVѥkr c rLsOZ2N '/Ȟ { '/Ȟ:.s[Y<ɠgv3i7虴L: F&MIA¤ ay0=H$L=B䡞Xqsl vFIjhIV $km6:AdMA%YDI6 $Q͂(iA$5HNR#9I$5HNR#9I$5hsgS^/ςO|Z;e朗U_ zə5i\QL54v8lkh}\%,X[vLU@ s=a\["U}O!%I F.dqF@'b= ~cD`r"ʏhwUA wFJD^Yp^Wp$e`EYEYQ^uH* N7HFQVeGRQV(+`]. e쉲T. XeGRQVEL;=/(ZSsd?5tڸhظv83.@Sl}#6r "G?iυk jHHG:--!/ھܵ DޥZuԧ32}OaM'#h7W|XY=W:JF{0-k7<52jjl<:H<XP8'g# ݌0 S#[,tf$豧ш{/{NnEzeG^/p2YڨQO"FĎڋuQ2jQ2(b2o:l3bkhU+'NpגZ-ݜusn5p78.S"Qd6=v ׌Hڸ )Q'?&d:/:~SrHWӪr-g7oppc$+Sh(="c4=>83:^QYf4#6QmԱW4Ui~װQ~Zx)&L-o =ۮ2545QR&Ͷjwak(w wɆIٚ;}h,Nrg,{>4? sMgQ=j-]]koRk6ֆ9L߽f6[jvteVӼ6/\m}[t+k:8}Yҭl=l0^vw[:LѴ+暻<Vo[k_2f$,l ,]vVsk ek;/YTF_1D^>}}8ި7pT]?pN/:ssn?>mj~?X 9E\pa*g|;Bd0-!hd==ɞFC#pO== dM({2z̙.gZYjO?J쌙{٩JJMcφ;u9J.g0qs\ī:n?* =B6$xM-aFӪe3ĖQw?wtyyAg3 endstream endobj 752 0 obj << /Type /XRef /Index [0 753] /Size 753 /W [1 3 1] /Root 750 0 R /Info 751 0 R /ID [<7B3F981DD800501CAF86A24BCFDCBBD5> <7B3F981DD800501CAF86A24BCFDCBBD5>] /Length 2175 /Filter /FlateDecode >> stream x%w\Us]2""Bn܀BAPRudZfK43-Grܒ"W9s|?>~s]纟cQcԈ)g؊Q`K6`˅FJƖ; i c˓$V)Eʖ7җf/*ҏa_,)ǾPUeyϾ e e Ⱦ:cK?g>4`vBvv vmvv76[ 5I-R!uI$G!iDb YŹl ӓnX,&1$#I8Kh+BL`;ڒ'bl_kޜE:T%v$d1 ':$ULXHx-g_!V{_&l9S#9bt%l|1qytlfd;6{eD4mDwʎ0M[/1fcӛ3:ގp1\m 3.˱ttNɋMV"f}tN١0 1 >fsjYfjq;/ ~>LKP6=?(MA8T!vHHF TžJHP:I.&P_"xEFPs1uuA$+>9/@C.A4h2D߀4bo84C HeI*OgEr2HHk%! لI|"@R)@ ʉw\ҮNAL >\LNȽ ŃY oP zrW ͐EJ?#շ82Q̀a@ 6 6 F0sF*8Qx>?RƆqMv_Xm[mD& e"L #` LFiG DPȔ*dxf,\'SL2k)ä;ѕϹa 0, $ WGbbS,~1_+j4\^s㮭 6QOd㶙´ll'v~\v1=`Gp o940rOqǙW'NNFSܡ3 wo> yNR ruH37.K!-ǞO ̍QY Cvyzb)QcF!ӕpo1nbT3; [bRg> Gcky8xv <緽>dz2PS&W䚺vnS-1D*zkIS/,KsZXp8 ekZ3o4Tm Rq!Rb#j( _j#ӋZCPij _ⵣ ơk3mc-SAlH^@jE1D_m$=D$ Zʾ4 MG7tFkG3fk6ߥ=[WsQ+r\qy(Қ`_$pz>{}s evAe v_\+qC"a!7qёл(: ٩v1ܗdjRʉlMb'sSPt*^':(B:]3f>>y5џlgN<z%H"5{5[ဃd*X˸9q [n]+Uju]-Y] 74J/-G{by+ Lw;ŌN4هe'Aj{HRYoUC҈4&MDƷ5{ endstream endobj startxref 185548 %%EOF xts/inst/doc/xts-faq.R0000644000176200001440000001465214552546764014352 0ustar liggesusers### R code from vignette source 'xts-faq.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### library("xts") Sys.setenv(TZ="GMT") ################################################### ### code chunk number 2: xts-faq.Rnw:88-90 (eval = FALSE) ################################################### ## filenames <- c("a.csv", "b.csv", "c.csv") ## sample.xts <- as.xts(do.call("rbind", lapply(filenames, read.zoo))) ################################################### ### code chunk number 3: xts-faq.Rnw:106-107 (eval = FALSE) ################################################### ## lm(sample.xts[, "Res"] ~ sample.xts[, "ThisVar"] + sample.xts[, "ThatVar"]) ################################################### ### code chunk number 4: xts-faq.Rnw:110-111 (eval = FALSE) ################################################### ## with(sample.xts, lm(Res ~ ThisVar + ThatVar)) ################################################### ### code chunk number 5: xts-faq.Rnw:118-121 ################################################### sample.xts <- xts(c(1:3, 0, 0, 0), as.POSIXct("1970-01-01")+0:5) sample.xts[sample.xts==0] <- NA cbind(orig=sample.xts, locf=na.locf(sample.xts)) ################################################### ### code chunk number 6: xts-faq.Rnw:128-130 ################################################### data(sample_matrix) sample.xts <- xts(1:10, seq(as.POSIXct("1970-01-01"), by=0.1, length=10)) ################################################### ### code chunk number 7: xts-faq.Rnw:138-140 ################################################### options(digits.secs=3) head(sample.xts) ################################################### ### code chunk number 8: xts-faq.Rnw:151-154 ################################################### dt <- as.POSIXct("2012-03-20 09:02:50.001") print(as.numeric(dt), digits=20) sprintf("%20.10f", dt) ################################################### ### code chunk number 9: xts-faq.Rnw:163-164 (eval = FALSE) ################################################### ## sample.xts.2 <- xts(t(apply(sample.xts, 1, myfun)), index(sample.xts)) ################################################### ### code chunk number 10: xts-faq.Rnw:172-177 ################################################### sample.xts <- xts(1:50, seq(as.POSIXct("1970-01-01"), as.POSIXct("1970-01-03")-1, length=50)) apply.daily(sample.xts, colMeans) period.apply(sample.xts, endpoints(sample.xts, "days"), colMeans) period.apply(sample.xts, endpoints(sample.xts, "hours", 6), colMeans) ################################################### ### code chunk number 11: xts-faq.Rnw:185-186 (eval = FALSE) ################################################### ## apply.daily(sample.xts['T06:00/T17:00',], colMeans) ################################################### ### code chunk number 12: xts-faq.Rnw:196-209 ################################################### sample.xts <- xts(1:6, as.POSIXct(c("2009-09-22 07:43:30", "2009-10-01 03:50:30", "2009-10-01 08:45:00", "2009-10-01 09:48:15", "2009-11-11 10:30:30", "2009-11-11 11:12:45"))) # align index into regular (e.g. 3-hour) blocks aligned.xts <- align.time(sample.xts, n=60*60*3) # apply your function to each block count <- period.apply(aligned.xts, endpoints(aligned.xts, "hours", 3), length) # create an empty xts object with the desired regular index empty.xts <- xts(, seq(start(aligned.xts), end(aligned.xts), by="3 hours")) # merge the counts with the empty object head(out1 <- merge(empty.xts, count)) # or fill with zeros head(out2 <- merge(empty.xts, count, fill=0)) ################################################### ### code chunk number 13: xts-faq.Rnw:219-220 (eval = FALSE) ################################################### ## sample.xts <- as.xts(transform(sample.xts, ABC=1)) ################################################### ### code chunk number 14: xts-faq.Rnw:224-225 (eval = FALSE) ################################################### ## tzone(sample.xts) <- Sys.getenv("TZ") ################################################### ### code chunk number 15: xts-faq.Rnw:237-238 (eval = FALSE) ################################################### ## sample.xts[sample.xts$Symbol == "AAPL" & index(sample.xts) == as.POSIXct("2011-09-21"),] ################################################### ### code chunk number 16: xts-faq.Rnw:241-242 (eval = FALSE) ################################################### ## sample.xts[sample.xts$Symbol == "AAPL"]['2011-09-21'] ################################################### ### code chunk number 17: xts-faq.Rnw:249-253 ################################################### data(sample_matrix) sample.xts <- as.xts(sample_matrix) wday.xts <- sample.xts[.indexwday(sample.xts) %in% 1:5] head(wday.xts) ################################################### ### code chunk number 18: xts-faq.Rnw:266-268 ################################################### Data <- data.frame(timestamp=as.Date("1970-01-01"), obs=21) sample.xts <- xts(Data[,-1], order.by=Data[,1]) ################################################### ### code chunk number 19: xts-faq.Rnw:272-275 ################################################### Data <- data.frame(obs=21, timestamp=as.Date("1970-01-01")) sample.xts <- xts(Data[,!grepl("timestamp",colnames(Data))], order.by=Data$timestamp) ################################################### ### code chunk number 20: xts-faq.Rnw:288-291 (eval = FALSE) ################################################### ## x1 <- align.time(xts(Data1$obs, Data1$timestamp), n=600) ## x2 <- align.time(xts(Data2$obs, Data2$timestamp), n=600) ## merge(x1, x2) ################################################### ### code chunk number 21: xts-faq.Rnw:295-301 ################################################### data(sample_matrix) sample.xts <- as.xts(sample_matrix) sample.xts["2007-01"]$Close <- sample.xts["2007-01"]$Close + 1 #Warning message: #In NextMethod(.Generic) : # number of items to replace is not a multiple of replacement length ################################################### ### code chunk number 22: xts-faq.Rnw:314-315 (eval = FALSE) ################################################### ## sample.xts["2007-01",]$Close <- sample.xts["2007-01"]$Close + 1 ################################################### ### code chunk number 23: xts-faq.Rnw:323-324 (eval = FALSE) ################################################### ## sample.xts["2007-01","Close"] <- sample.xts["2007-01","Close"] + 1 xts/inst/include/0000755000176200001440000000000014522244665013502 5ustar liggesusersxts/inst/include/xts_stubs.c0000644000176200001440000000011414522244665015700 0ustar liggesusers #warning("This header is deprecated. Please include 'xtsAPI.h' instead.") xts/inst/include/xts.h0000644000176200001440000000746614522244665014506 0ustar liggesusers/* Header file for using internal C-level facilities provided by xts. This is not 100% designed for end users, so any user comments and bug reports are very welcomed. Copyright Jeffrey A. Ryan 2008 This source is distributed with the same license as the full xts software, GPL (>= 2). */ #include #include #include #ifndef _XTS #define _XTS #ifdef __cplusplus extern "C" { #endif /* INTERNAL SYMBOLS */ extern SEXP xts_IndexSymbol; extern SEXP xts_ClassSymbol; extern SEXP xts_IndexTformatSymbol; extern SEXP xts_IndexTclassSymbol; extern SEXP xts_IndexTzoneSymbol; /* DATA TOOLS */ #define xts_ATTRIB(x) coerceVector(do_xtsAttributes(x),LISTSXP) #define xts_COREATTRIB(x) coerceVector(do_xtsCoreAttributes(x),LISTSXP) // attr(x, 'index') or .index(x) #define GET_xtsIndex(x) getAttrib(x, xts_IndexSymbol) #define SET_xtsIndex(x,value) setAttrib(x, xts_IndexSymbol, value) // attr(x, '.indexFORMAT') or indexFormat(x) #define GET_xtsIndexFormat(x) getAttrib(x, xts_IndexFormatSymbol) #define SET_xtsIndexFormat(x,value) setAttrib(x, xts_IndexFormatSymbol, value) // attr(x, '.CLASS') or CLASS(x) #define GET_xtsCLASS(x) getAttrib(x, xts_ClassSymbol) #define SET_xtsCLASS(x,value) setAttrib(x, xts_ClassSymbol, value) /* IMPORTS FROM zoo */ extern SEXP(*zoo_lag)(SEXP,SEXP,SEXP); extern SEXP(*zoo_coredata)(SEXP,SEXP); /* FUNCTIONS */ SEXP do_xtsAttributes(SEXP x); // xtsAttributes i.e. user-added attributes SEXP add_xtsCoreAttributes(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP do_xtsCoreAttributes(SEXP x); /* xtsCoreAttributes xts-specific attributes CLASS, .indexFORMAT, tclass, & class */ SEXP coredata(SEXP x, SEXP copyAttr); SEXP coredata_xts(SEXP x); SEXP add_class(SEXP x, SEXP klass); SEXP lagXts(SEXP x, SEXP k, SEXP pad); SEXP lag_xts(SEXP x, SEXP k, SEXP pad); SEXP do_is_ordered(SEXP x, SEXP increasing, SEXP strictly); SEXP mergeXts(SEXP args); SEXP do_rbind_xts(SEXP x, SEXP y, SEXP dup); SEXP rbindXts(SEXP args); SEXP do_subset_xts(SEXP x, SEXP sr, SEXP sc, SEXP drop); SEXP _do_subset_xts(SEXP x, SEXP sr, SEXP sc, SEXP drop); SEXP number_of_cols(SEXP args); SEXP naCheck(SEXP x, SEXP check); SEXP make_index_unique(SEXP x, SEXP eps); SEXP make_unique(SEXP X, SEXP eps); SEXP endpoints(SEXP _x, SEXP _on, SEXP _k, SEXP _addlast); SEXP do_merge_xts(SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass, SEXP colnames, SEXP suffixes, SEXP retside, SEXP check_names, SEXP env, SEXP coerce); SEXP na_omit_xts(SEXP x); SEXP na_locf(SEXP x, SEXP fromlast, SEXP maxgap, SEXP limit); SEXP tryXts(SEXP x); SEXP binsearch(SEXP, SEXP, SEXP); SEXP any_negative(SEXP); SEXP fill_window_dups_rev(SEXP data, SEXP index); SEXP non_duplicates(SEXP data, SEXP from_last); SEXP toPeriod(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP xts_period_apply(SEXP data, SEXP index, SEXP function, SEXP env); SEXP xts_period_min(SEXP data, SEXP index); SEXP xts_period_max(SEXP data, SEXP index); SEXP xts_period_sum(SEXP data, SEXP index); SEXP xts_period_prod(SEXP data, SEXP index); SEXP roll_min(SEXP x, SEXP n); SEXP roll_max(SEXP x, SEXP n); SEXP roll_sum(SEXP x, SEXP n); SEXP roll_cov(SEXP x, SEXP n, SEXP sample, SEXP); SEXP dimnames_zoo(SEXP x); SEXP xts_set_dimnames(SEXP x, SEXP value); void copyAttributes(SEXP x, SEXP y); // internal only void copy_xtsAttributes(SEXP x, SEXP y); // internal only void copy_xtsCoreAttributes(SEXP x, SEXP y);// internal only SEXP isXts(SEXP x); // is.xts analogue int firstNonNA(SEXP x); SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_); SEXP do_startofyear(SEXP from, SEXP to, SEXP origin); int xts_ncols(SEXP x); #endif /* _XTS */ #ifdef __cplusplus } #endif xts/inst/include/xtsAPI.h0000644000176200001440000000732014522244665015025 0ustar liggesusers/* Header file for using internal C-level facilities provided by xts. This is not 100% designed for end users, so any user comments and bug reports are very welcomed. Copyright 2008 - 2014 Jeffrey A. Ryan Copyright 2014 Dirk Eddelbuettel This source is distributed with the same license as the full xts software, GPL (>= 2). */ #ifndef _XTS_API_H #define _XTS_API_H #include // also includes R.h, Rinternals.h, Rdefines.h #include #include #ifdef HAVE_VISIBILITY_ATTRIBUTE # define attribute_hidden __attribute__ ((visibility ("hidden"))) #else # define attribute_hidden #endif #ifdef __cplusplus extern "C" { #endif /* To aid those looking for answers on interfacing compiled code from another package. This is simply constructing a function pointer for use. static RETURNTYPE(*fun)(ARG1,ARG2) = NULL where ARGS are the types accepted, comma seperated fun = ( RETURNTYPE(*)(ARG1,ARG2)) R_GetCCallable("PACKAGENAME", "FUNCTIONNAME") */ SEXP attribute_hidden xtsIs(SEXP x) { static SEXP(*fun)(SEXP) = (SEXP(*)(SEXP)) R_GetCCallable("xts","isXts"); return fun(x); } SEXP attribute_hidden xtsIsOrdered(SEXP x, SEXP increasing, SEXP strictly) { static SEXP(*fun)(SEXP,SEXP,SEXP) = (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("xts","do_is_ordered"); return fun(x, increasing, strictly); } SEXP attribute_hidden xtsNaCheck(SEXP x, SEXP check) { static SEXP(*fun)(SEXP,SEXP) = (SEXP(*)(SEXP,SEXP)) R_GetCCallable("xts","naCheck"); return fun(x, check); } SEXP attribute_hidden xtsTry(SEXP x) { static SEXP(*fun)(SEXP) = (SEXP(*)(SEXP)) R_GetCCallable("xts","tryXts"); return fun(x); } SEXP attribute_hidden xtsRbind(SEXP x, SEXP y, SEXP dup) { static SEXP(*fun)(SEXP, SEXP, SEXP) = (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("xts","do_rbind_xts"); return fun(x, y, dup); } SEXP attribute_hidden xtsCoredata(SEXP x) { static SEXP(*fun)(SEXP) = (SEXP(*)(SEXP)) R_GetCCallable("xts","coredata_xts"); return fun(x); } SEXP attribute_hidden xtsLag(SEXP x, SEXP k, SEXP pad) { static SEXP(*fun)(SEXP,SEXP,SEXP) = (SEXP(*)(SEXP,SEXP,SEXP)) R_GetCCallable("xts","lagXts"); return fun(x, k, pad); } SEXP attribute_hidden xtsMakeIndexUnique(SEXP x, SEXP eps) { static SEXP(*fun)(SEXP,SEXP) = (SEXP(*)(SEXP,SEXP)) R_GetCCallable("xts","make_index_unique"); return fun(x, eps); } SEXP attribute_hidden xtsMakeUnique(SEXP x, SEXP eps) { static SEXP(*fun)(SEXP,SEXP) = (SEXP(*)(SEXP,SEXP)) R_GetCCallable("xts","make_unique"); return fun(x, eps); } SEXP attribute_hidden xtsEndpoints(SEXP x, SEXP on, SEXP k, SEXP addlast) { static SEXP(*fun)(SEXP,SEXP,SEXP,SEXP) = (SEXP(*)(SEXP,SEXP,SEXP,SEXP)) R_GetCCallable("xts","endpoints"); return fun(x, on, k, addlast); } SEXP attribute_hidden xtsMerge(SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass, SEXP colnames, SEXP suffixes, SEXP retside, SEXP check_names, SEXP env, SEXP coerce) { static SEXP(*fun)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP) = (SEXP(*)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP)) R_GetCCallable("xts","do_merge_xts"); return fun(x, y, all, fill, retclass, colnames, suffixes, retside, check_names, env, coerce); } SEXP attribute_hidden xtsNaOmit(SEXP x) { static SEXP(*fun)(SEXP) = (SEXP(*)(SEXP)) R_GetCCallable("xts","na_omit_xts"); return fun(x); } SEXP attribute_hidden xtsNaLocf(SEXP x, SEXP fromLast, SEXP maxgap, SEXP limit) { static SEXP(*fun)(SEXP,SEXP,SEXP,SEXP) = (SEXP(*)(SEXP,SEXP,SEXP,SEXP)) R_GetCCallable("xts","na_locf"); return fun(x, fromLast, maxgap, limit); } #ifdef __cplusplus } #endif #endif /* !_XTS_API_H */ xts/inst/tinytest/0000755000176200001440000000000014552531337013740 5ustar liggesusersxts/inst/tinytest/test-reclass.R0000644000176200001440000000341414531465366016503 0ustar liggesusers# ensure reclass() preserves index attributes from 'match.to' info_msg <- "test.reclass_preserves_match.to_tclass" x <- .xts(1:3, 1:3, tclass = "Date") y <- reclass(1:3, match.to = x) expect_identical(tclass(y), "Date", info = info_msg) info_msg <- "test.reclass_preserves_match.to_tzone" tz <- "Atlantic/Reykjavik" x <- .xts(1:3, 1:3, tzone = tz) y <- reclass(1:3, match.to = x) expect_identical(tzone(y), tz, info = info_msg) info_msg <- "test.reclass_preserves_match.to_tformat" tf <- "%m/%d/%Y %H:%M" x <- .xts(1:3, 1:3, tformat = tf) y <- reclass(1:3, match.to = x) expect_identical(tformat(y), tf, info = info_msg) info_msg <- "test.reclass_preserves_match.to_xtsAttributes" xts_attr <- list("hello" = "world") x <- .xts(1:3, 1:3) xtsAttributes(x) <- xts_attr z <- reclass(1:3, match.to = x) expect_equal(xts_attr, xtsAttributes(z), info = info_msg) # ensure reclass(xts_object, ...) preserves match.to attributes info_msg <- "test.reclass_xts_object_preserves_match.to_tclass" x <- y <- xts(1:3, .Date(1:3)) tclass(x) <- c("POSIXct", "POSIXt") z <- reclass(x, y) expect_identical(tclass(y), tclass(z), info = info_msg) info_msg <- "test.reclass_xts_object_preserves_match.to_tzone" x <- y <- xts(1:3, .Date(1:3)) tz <- "Atlantic/Reykjavik" tzone(x) <- tz z <- reclass(x, y) expect_identical("UTC", tzone(z), info = info_msg) info_msg <- "test.reclass_xts_object_preserves_match.to_tformat" tf <- "%m/%d/%Y" x <- y <- xts(1:3, .Date(1:3), tformat = tf) tformat(x) <- "%Y-%m-%d" z <- reclass(x, y) expect_identical(tf, tformat(z), info = info_msg) info_msg <- "test.reclass_xts_object_preserves_match.to_xtsAttributes" x <- y <- xts(1:3, .Date(1:3)) xts_attr <- list("hello" = "world") xtsAttributes(y) <- xts_attr z <- reclass(x, y) expect_equal(xts_attr, xtsAttributes(z), info = info_msg) xts/inst/tinytest/runit.rowSums-rowMeans.R0000644000176200001440000000120214522244665020470 0ustar liggesusers test.rowSums_dispatch <- function() { x <- xts(cbind(1:3, 4:6), .Date(1:3)) y <- xts(base::rowSums(x), index(x)) checkEqualsNumeric(y, rowSums(x)) checkEquals(index(y), index(x)) d <- data.frame(x) v <- as.vector(y) checkEqualsNumeric(v, rowSums(d)) checkEquals(rownames(d), as.character(index(x))) } test.rowMeans_dispatch <- function() { x <- xts(cbind(1:3, 4:6), .Date(1:3)) y <- xts(base::rowMeans(x), index(x)) checkEqualsNumeric(y, rowMeans(x)) checkEquals(index(y), index(x)) d <- data.frame(x) v <- as.vector(y) checkEqualsNumeric(v, rowMeans(d)) checkEquals(rownames(d), as.character(index(x))) } xts/inst/tinytest/test-first-last.R0000644000176200001440000002635614522244665017146 0ustar liggesusersdates <- c("2017-01-01", "2017-01-02", "2017-01-03", "2017-01-04") d1 <- data.frame(x = seq_along(dates), row.names = dates) d2 <- data.frame(d1, y = rev(seq_along(dates))) ### basic functionality on data.frame info_msg <- "test.first_xtsible_data.frame_pos_n" expect_identical(first(d1, 1), head(d1, 1), info = info_msg) expect_identical(first(d2, 1), head(d2, 1), info = info_msg) expect_identical(first(d1, "1 day"), head(d1, 1), info = info_msg) expect_identical(first(d2, "1 day"), head(d2, 1), info = info_msg) info_msg <- "test.first_xtsible_data.frame_neg_n" expect_identical(first(d1, -1), tail(d1, -1), info = info_msg) expect_identical(first(d2, -1), tail(d2, -1), info = info_msg) expect_identical(first(d1, "-1 day"), tail(d1, -1), info = info_msg) expect_identical(first(d2, "-1 day"), tail(d2, -1), info = info_msg) info_msg <- "test.first_xtsible_data.frame_zero_n" expect_identical(first(d1, 0), head(d1, 0), info = info_msg) expect_identical(first(d2, 0), head(d2, 0), info = info_msg) expect_identical(first(d1, "0 day"), head(d1, 0), info = info_msg) expect_identical(first(d2, "0 day"), head(d2, 0), info = info_msg) info_msg <- "test.last_xtsible_data.frame_pos_n" expect_identical(last(d1, 1), tail(d1, 1), info = info_msg) expect_identical(last(d2, 1), tail(d2, 1), info = info_msg) expect_identical(last(d1, "1 day"), tail(d1, 1), info = info_msg) expect_identical(last(d2, "1 day"), tail(d2, 1), info = info_msg) info_msg <- "test.last_xtsible_data.frame_neg_n" expect_identical(last(d1, -1), head(d1, -1), info = info_msg) expect_identical(last(d2, -1), head(d2, -1), info = info_msg) expect_identical(last(d1, "-1 day"), head(d1, -1), info = info_msg) expect_identical(last(d2, "-1 day"), head(d2, -1), info = info_msg) info_msg <- "test.last_xtsible_data.frame_zero_n" expect_identical(last(d1, 0), head(d1, 0), info = info_msg) expect_identical(last(d2, 0), head(d2, 0), info = info_msg) expect_identical(last(d1, "0 day"), head(d1, 0), info = info_msg) expect_identical(last(d2, "0 day"), head(d2, 0), info = info_msg) ### non-xtsible data.frames d1 <- data.frame(x = seq_along(dates), row.names = dates) d2 <- data.frame(d1, y = rev(seq_along(dates))) rownames(d1) <- rownames(d2) <- NULL info_msg <- "test.first_nonxtsible_data.frame_pos_n" expect_identical(first(d1, 1), head(d1, 1), info = info_msg) expect_identical(first(d2, 1), head(d2, 1), info = info_msg) info_msg <- "test.first_nonxtsible_data.frame_neg_n" rownames(d1) <- rownames(d2) <- NULL expect_identical(first(d1, -1), tail(d1, -1), info = info_msg) expect_identical(first(d2, -1), tail(d2, -1), info = info_msg) info_msg <- "test.first_nonxtsible_data.frame_zero_n" rownames(d1) <- rownames(d2) <- NULL expect_identical(first(d1, 0), tail(d1, 0), info = info_msg) expect_identical(first(d2, 0), tail(d2, 0), info = info_msg) info_msg <- "test.last_nonxtsible_data.frame_pos_n" rownames(d1) <- rownames(d2) <- NULL expect_identical(last(d1, 1), tail(d1, 1), info = info_msg) expect_identical(last(d2, 1), tail(d2, 1), info = info_msg) info_msg <- "test.last_nonxtsible_data.frame_neg_n" rownames(d1) <- rownames(d2) <- NULL expect_identical(last(d1, -1), head(d1, -1), info = info_msg) expect_identical(last(d2, -1), head(d2, -1), info = info_msg) info_msg <- "test.last_nonxtsible_data.frame_zero_n" rownames(d1) <- rownames(d2) <- NULL expect_identical(last(d1, 0), head(d1, 0), info = info_msg) expect_identical(last(d2, 0), head(d2, 0), info = info_msg) ### basic functionality on matrix d1 <- data.frame(x = seq_along(dates), row.names = dates) d2 <- data.frame(d1, y = rev(seq_along(dates))) m1 <- as.matrix(d1) m2 <- as.matrix(d2) info_msg <- "test.first_xtsible_matrix_pos_n" expect_identical(first(m1, 1), head(m1, 1), info = info_msg) expect_identical(first(m2, 1), head(m2, 1), info = info_msg) expect_identical(first(m1, "1 day"), head(m1, 1), info = info_msg) expect_identical(first(m2, "1 day"), head(m2, 1), info = info_msg) info_msg <- "test.first_xtsible_matrix_neg_n" expect_identical(first(m1, -1), tail(m1, -1, keepnums = FALSE), info = info_msg) expect_identical(first(m2, -1), tail(m2, -1, keepnums = FALSE), info = info_msg) expect_identical(first(m1, "-1 day"), tail(m1, -1, keepnums = FALSE), info = info_msg) expect_identical(first(m2, "-1 day"), tail(m2, -1, keepnums = FALSE), info = info_msg) info_msg <- "test.first_xtsible_matrix_zero_n" expect_identical(first(m1, 0), tail(m1, 0, keepnums = FALSE), info = info_msg) expect_identical(first(m2, 0), tail(m2, 0, keepnums = FALSE), info = info_msg) expect_identical(first(m1, "0 day"), tail(m1, 0, keepnums = FALSE), info = info_msg) expect_identical(first(m2, "0 day"), tail(m2, 0, keepnums = FALSE), info = info_msg) info_msg <- "test.last_xtsible_matrix_pos_n" expect_identical(last(m1, 1), tail(m1, 1, keepnums = FALSE), info = info_msg) expect_identical(last(m2, 1), tail(m2, 1, keepnums = FALSE), info = info_msg) expect_identical(last(m1, "1 day"), tail(m1, 1, keepnums = FALSE), info = info_msg) expect_identical(last(m2, "1 day"), tail(m2, 1, keepnums = FALSE), info = info_msg) info_msg <- "test.last_xtsible_matrix_neg_n" expect_identical(last(m1, -1), head(m1, -1), info = info_msg) expect_identical(last(m2, -1), head(m2, -1), info = info_msg) info_msg <- "test.last_xtsible_matrix_zero_n" expect_identical(last(m1, 0), head(m1, 0), info = info_msg) expect_identical(last(m2, 0), head(m2, 0), info = info_msg) info_msg <- "test.first_nonxtsible_matrix_pos_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(first(m1, 1), head(m1, 1), info = info_msg) expect_identical(first(m2, 1), head(m2, 1), info = info_msg) info_msg <- "test.first_nonxtsible_matrix_neg_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(first(m1, -1), tail(m1, -1, keepnums = FALSE), info = info_msg) expect_identical(first(m2, -1), tail(m2, -1, keepnums = FALSE), info = info_msg) info_msg <- "test.first_nonxtsible_matrix_zero_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(first(m1, 0), tail(m1, 0, keepnums = FALSE), info = info_msg) expect_identical(first(m2, 0), tail(m2, 0, keepnums = FALSE), info = info_msg) info_msg <- "test.last_nonxtsible_matrix_pos_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(last(m1, 1), tail(m1, 1, keepnums = FALSE), info = info_msg) expect_identical(last(m2, 1), tail(m2, 1, keepnums = FALSE), info = info_msg) info_msg <- "test.last_nonxtsible_matrix_neg_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(last(m1, -1), head(m1, -1), info = info_msg) expect_identical(last(m2, -1), head(m2, -1), info = info_msg) info_msg <- "test.last_nonxtsible_matrix_zero_n" rownames(m1) <- rownames(m2) <- NULL expect_identical(last(m1, 0), head(m1, 0), info = info_msg) expect_identical(last(m2, 0), head(m2, 0), info = info_msg) ### basic functionality on vector d1 <- data.frame(x = seq_along(dates), row.names = dates) d2 <- data.frame(d1, y = rev(seq_along(dates))) info_msg <- "test.first_xtsible_vector" v1 <- setNames(d1$x, rownames(d1)) expect_identical(first(v1, 1), head(v1, 1), info = info_msg) expect_identical(first(v1,-1), tail(v1,-1), info = info_msg) expect_identical(first(v1, "1 day"), head(v1, 1), info = info_msg) expect_identical(first(v1,"-1 day"), tail(v1,-1), info = info_msg) expect_identical(first(v1, "2 days"), head(v1, 2), info = info_msg) expect_identical(first(v1,"-2 days"), tail(v1,-2), info = info_msg) d <- .Date(3) + 1:21 expect_identical(first(d, "1 week"), head(d, 7), info = info_msg) expect_identical(first(d,"-1 week"), tail(d,-7), info = info_msg) expect_identical(first(d, "2 weeks"), head(d, 14), info = info_msg) expect_identical(first(d,"-2 weeks"), tail(d,-14), info = info_msg) info_msg <- "test.last_xtsible_vector" v1 <- setNames(d1$x, rownames(d1)) expect_identical(last(v1, 1), tail(v1, 1), info = info_msg) expect_identical(last(v1,-1), head(v1,-1), info = info_msg) expect_identical(last(v1, "1 day"), tail(v1, 1), info = info_msg) expect_identical(last(v1,"-1 day"), head(v1,-1), info = info_msg) d <- .Date(3) + 1:21 expect_identical(last(d, "1 week"), tail(d, 7), info = info_msg) expect_identical(last(d,"-1 week"), head(d,-7), info = info_msg) expect_identical(last(d, "2 weeks"), tail(d, 14), info = info_msg) expect_identical(last(d,"-2 weeks"), head(d,-14), info = info_msg) info_msg <- "test.first_nonxtsible_vector" v1 <- d1$x expect_identical(first(v1, 1), head(v1, 1), info = info_msg) expect_identical(first(v1,-1), tail(v1,-1), info = info_msg) expect_identical(first(v1,0), tail(v1,0), info = info_msg) info_msg <- "test.last_nonxtsible_vector" v1 <- d1$x expect_identical(last(v1, 1), tail(v1, 1), info = info_msg) expect_identical(last(v1,-1), head(v1,-1), info = info_msg) expect_identical(last(v1,0), head(v1,0), info = info_msg) ### zero-length vectors info_msg <- "test.zero_length_vector" types <- c("logical", "integer", "numeric", "complex", "character", "raw") for (type in types) { v <- vector(type, 0) expect_identical(first(v, 1), v, info = paste(info_msg, type, "- first, n = 1")) expect_identical( last(v, 1), v, info = paste(info_msg, type, "- last, n = 1")) # negative 'n' expect_identical(first(v, -1), v, info = paste(info_msg, type, "- first, n = -1")) expect_identical( last(v, -1), v, info = paste(info_msg, type, "- last, n = -1")) #zero 'n' expect_identical(first(v, 0), v, info = paste(info_msg, type, "- first, n = 0")) expect_identical( last(v, 0), v, info = paste(info_msg, type, "- last, n = 0")) } ### zero-row matrix info_msg <- "test.zero_row_matrix" types <- c("logical", "integer", "numeric", "complex", "character", "raw") for (type in types) { m <- matrix(vector(type, 0), 0) expect_identical(first(m, 1), m, info = paste(info_msg, type, "- first, n = 1")) expect_identical( last(m, 1), m, info = paste(info_msg, type, "- last, n = 1")) # negative 'n' expect_identical(first(m, -1), m, info = paste(info_msg, type, "- first, n = -1")) expect_identical( last(m, -1), m, info = paste(info_msg, type, "- last, n = -1")) #zero 'n' expect_identical(first(m, 0), m, info = paste(info_msg, type, "- first, n = 0")) expect_identical( last(m, 0), m, info = paste(info_msg, type, "- last, n = 0")) } ### tests for zoo z1 <- zoo(seq_along(dates), as.Date(dates)) z2 <- merge(x = z1, y = rev(seq_along(dates))) info_msg <- "test.first_zoo_pos_n" expect_identical(first(z1, 1), head(z1, 1), info = info_msg) expect_identical(first(z2, 1), head(z2, 1), info = info_msg) expect_identical(first(z1, "1 day"), head(z1, 1), info = info_msg) expect_identical(first(z2, "1 day"), head(z2, 1), info = info_msg) info_msg <- "test.first_zoo_neg_n" expect_identical(first(z1, -1), tail(z1, -1), info = info_msg) expect_identical(first(z2, -1), tail(z2, -1), info = info_msg) expect_identical(first(z1, "-1 day"), tail(z1, -1), info = info_msg) expect_identical(first(z2, "-1 day"), tail(z2, -1), info = info_msg) info_msg <- "test.last_zoo_pos_n" expect_identical(last(z1, 1), tail(z1, 1), info = info_msg) expect_identical(last(z2, 1), tail(z2, 1), info = info_msg) expect_identical(last(z1, "1 day"), tail(z1, 1), info = info_msg) expect_identical(last(z2, "1 day"), tail(z2, 1), info = info_msg) info_msg <- "test.last_zoo_neg_n" expect_identical(last(z1, -1), head(z1, -1), info = info_msg) expect_identical(last(z2, -1), head(z2, -1), info = info_msg) expect_identical(last(z1, "-1 day"), head(z1, -1), info = info_msg) expect_identical(last(z2, "-1 day"), head(z2, -1), info = info_msg) xts/inst/tinytest/test-timeBasedSeq.R0000644000176200001440000000572214522244665017416 0ustar liggesusers# timeBasedSeq tests # 1999 to 2008 by year, Date info_msg <- "test.tbs_1999_to_2008_by_year_Date" tbs <- timeBasedSeq('1999/2008') bench <- seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='year') expect_equivalent(tbs, bench, info = info_msg) # 1999 to 2008 by year, retclass='Date' info_msg <- "test.tbs_1999_to_2008_by_year_retclassDate" tbs <- timeBasedSeq('1999/2008', retclass='Date') bench <- seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='year') expect_equivalent(tbs, bench, info = info_msg) # 1999 to 2008 by year, retclass="POSIXct" info_msg <- "test.tbs_1999_to_2008_by_year" tbs <- timeBasedSeq('1999/2008',retclass='POSIXct') bench <- seq(as.POSIXct("1999-01-01"),as.POSIXct("2008-01-01"),by='year') expect_equivalent(tbs, bench, info = info_msg) # MONTHLY sequences # defaults to yearmon from the zoo package # NB: these differ by ~4.16e-5 on Solaris and rhub's windows-x86_64-devel info_msg <- "test.tbs_199901_to_200801_by_month" tbs <- timeBasedSeq('199901/200801') bench <- as.yearmon(seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='month')) expect_equivalent(tbs, bench, tolerance = 1e-4, info = info_msg) info_msg <- "test.tbs_199901_to_2008_by_month" tbs <- timeBasedSeq('199901/2008') bench <- as.yearmon(seq(as.Date("1999-01-01"),as.Date("2008-12-01"),by='month')) expect_equivalent(tbs, bench, tolerance = 1e-4, info = info_msg) info_msg <- "test.tbs_1999_to_200801_by_month" tbs <- timeBasedSeq('1999/200801') bench <- as.yearmon(seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='month')) expect_equivalent(tbs, bench, tolerance = 1e-4, info = info_msg) # retclass=Date info_msg <- "test.tbs_199901_to_200801_by_month_Date" tbs <- timeBasedSeq('199901/200801', retclass='Date') bench <- seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='month') expect_equivalent(tbs, bench, info = info_msg) info_msg <- "test.tbs_199901_to_2008_by_month_Date" tbs <- timeBasedSeq('199901/2008', retclass='Date') bench <- seq(as.Date("1999-01-01"),as.Date("2008-12-01"),by='month') expect_equivalent(tbs, bench, info = info_msg) info_msg <- "test.tbs_1999_to_200801_by_month_Date" tbs <- timeBasedSeq('1999/200801', retclass='Date') bench <- as.Date(seq(as.Date("1999-01-01"),as.Date("2008-01-01"),by='month')) expect_equivalent(tbs, bench, info = info_msg) # retclass=POSIXct info_msg <- "test.tbs_199901_to_200801_by_month_POSIXct" tbs <- timeBasedSeq('199901/200801', retclass='POSIXct') bench <- seq(as.POSIXct("1999-01-01"),as.POSIXct("2008-01-01"),by='month') expect_equivalent(tbs, bench, info = info_msg) info_msg <- "test.tbs_199901_to_2008_by_month_POSIXct" tbs <- timeBasedSeq('199901/2008', retclass='POSIXct') bench <- as.POSIXct(seq(as.POSIXct("1999-01-01"),as.POSIXct("2008-12-01"),by='month')) expect_equivalent(tbs, bench, info = info_msg) info_msg <- "test.tbs_1999_to_200801_by_month_POSIXct" tbs <- timeBasedSeq('1999/200801', retclass='POSIXct') bench <- seq(as.POSIXct("1999-01-01"),as.POSIXct("2008-01-01"),by='month') expect_equivalent(tbs, bench, info = info_msg) xts/inst/tinytest/test-to.period.R0000644000176200001440000000173314522244665016751 0ustar liggesusers# ensure first group is included in output info_msg <- "test.to.frequency_includes_first_group" data(sample_matrix) x <- as.xts(sample_matrix) x$Volume <- 1 tf <- xts:::to.frequency(x, x$Volume, 90, name=NULL) tp <- .Call(xts:::C_toPeriod, x, c(0L, 90L, 180L), TRUE, 5L, FALSE, FALSE, c("Open", "High", "Low", "Close", "Volume")) expect_identical(tf, tp, info = info_msg) info_msg <- "test.to.period_custom_endpoints" data(sample_matrix) x <- as.xts(sample_matrix) ep <- endpoints(x, "months", 1) y1 <- to.period(x, "months", 1) y2 <- to.period(x, ep) expect_identical(y1, y2, info = info_msg) # period must be character or numeric expect_error(to.period(x, TRUE), info = "period must be character or numeric") # 'k' and 'indexAt' are ignored expect_warning(to.period(x, ep, k = 2), info = "'k' is ignored when endpoints are provided") expect_warning(to.period(x, ep, indexAt = ""), info = "'indexAt' is ignored when endpoints are provided") xts/inst/tinytest/test-print.R0000644000176200001440000000422614525744640016203 0ustar liggesusersx <- xts(cbind(1:10, 1:10), .Date(1:10)) # NOTE: expected value is (2 + 2) to account for # (1) column header: " [,1] [,2]" # (2) message: "[ reached getOption("max.print") -- omitted 6 rows ]" print_output <- utils::capture.output(print(x, max = 4)) expect_true(length(print_output) == (2 + 2), info = "'max' argument is respected'") print_output <- utils::capture.output(print(x, max = 4, show.nrows = 10)) expect_true(length(print_output) == (2 + 2), info = "'max' takes precedence over 'show.nrows'") expect_silent(p <- print(drop(x[, 1])), info = "print.xts() does not error when object doesn't have dims") print_output <- utils::capture.output(print(drop(x[1:2, 1]))) expect_true(all(grepl("1970-01", print_output[-1])), info = "print.xts() output shows index when object doesn't have dims") # 'show.nrows' > 'trunc.rows' print_output <- utils::capture.output(print(x, show.nrows = 10, trunc.rows = 4)) expect_true(length(print_output)-1 == nrow(x), info = "print.xts() shows correct number of rows when show.nrows > trunc.rows") y <- xts(cbind(1:11, 1:11), .Date(1:11)) show_nrows <- floor(nrow(y) / 2) print_output <- utils::capture.output(print(y, show.nrows = show_nrows, trunc.rows = nrow(y)-2)) expect_true(length(print_output)-1 == 2*show_nrows+1, info = "print.xts() shows correct number of rows when show.nrows < trunc.rows / 2") show_nrows <- ceiling(nrow(y) / 2) print_output <- utils::capture.output(print(y, show.nrows = show_nrows, trunc.rows = nrow(y)-2)) expect_true(length(print_output)-1 == nrow(y), info = "print.xts() shows correct number of rows when show.nrows > trunc.rows / 2") print_output <- utils::capture.output(p <- print(x)) expect_identical(p, x, info = "returns input invisibly") z <- .xts(matrix(0, nrow = 200, ncol = 200), 1:200) expect_silent(print(z), info = "print more columns than width doesn't error") expect_silent(print(x, quote = TRUE), info = "print.xts() does not error when 'quote' argument is used") expect_silent(print(x, right = TRUE), info = "print.xts() does not error when 'right' argument is used") xts/inst/tinytest/test-xts.methods.R0000644000176200001440000002711114522244665017324 0ustar liggesusers# unit tests for the following 'xts' methods: # rbind # cbind # info_msg <- "test.rbind_zero_length_non_zero_length_POSIXct_errors" xpz <- xts( , as.POSIXct("2017-01-01")) xp1 <- xts(1, as.POSIXct("2017-01-02")) zpz <- as.zoo(xpz) zp1 <- as.zoo(xp1) zpe <- tryCatch(rbind(zpz, zp1), error = identity) xpe <- tryCatch(rbind(xpz, xp1), error = identity) expect_identical(zpe$message, xpe$message, info = info_msg) info_msg <- "test.rbind_zero_length_non_zero_length_Date_errors" xpz <- xts( , as.Date("2017-01-01")) xp1 <- xts(1, as.Date("2017-01-02")) zpz <- as.zoo(xpz) zp1 <- as.zoo(xp1) zpe <- tryCatch(rbind(zpz, zp1), error = identity) xpe <- tryCatch(rbind(xpz, xp1), error = identity) expect_identical(zpe$message, xpe$message, info = info_msg) info_msg <- "test.rbind_no_dim_does_not_error" d <- rep(0.1, 2) i <- rep(581910048, 2) xts_no_dim <- structure(d[1], class = c("xts", "zoo"), index = structure(i[1], tzone = "UTC", tclass = "Date")) xts_out <- structure(d, class = c("xts", "zoo"), .Dim = 2:1, index = structure(i, tzone = "UTC", tclass = "Date")) xts_rbind <- rbind(xts_no_dim, xts_no_dim) expect_identical(xts_out, xts_rbind, info = info_msg) # Test that as.Date.numeric() works at the top level (via zoo::as.Date()), # and for functions defined in the xts namespace even if xts::as.Date.numeric() # is not formally registered as an S3 method. info_msg <- "test.as.Date.numeric" # Define function that calls as.Date.numeric() ... f <- function(d) { as.Date(d) } # ... in xts' namespace environment(f) <- as.environment("package:xts") dd <- as.Date("2017-12-13") dn <- unclass(dd) expect_identical(dd, as.Date(dn), info = info_msg) # via zoo::as.Date() expect_identical(dd, f(dn), info = info_msg) # .subset.xts # window.xts # .toPOSIXct (indirectly) info_msg <- "test.window" # window function for xts series, use basic logic for testing & debugging # null start and end not supported window_dbg <- function(x, index. = index(x), start, end) { start <- xts:::.toPOSIXct(start, tzone(x)) end <- xts:::.toPOSIXct(end, tzone(x)) index. <- as.POSIXct(index., tz=tzone(x)) all.indexes <- .index(x) in.index <- all.indexes %in% as.numeric(index.) matches <- (in.index & all.indexes >= start & all.indexes <= end) x[matches,] } DAY = 24*3600 base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20)*DAY x <- xts(1:length(dts), dts) # Range over gap start <- base + 11*DAY end <- base + 16*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range over gap")) # Range over one day start <- base + 12*DAY end <- base + 12*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range over one day")) # Empty Range over one day start <- base + 11*DAY end <- base + 11*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- empty Range over one day")) # Range containing all dates start <- base end <- base + 21*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range containing all dates")) # Range past end start <- base + 16*DAY end <- base + 30*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range past end")) # Range before begin start <- base end <- base + 3*DAY bin <- window(x, start = start, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- range before begin")) # Test just start, end = NULL start <- base + 13 * DAY end <- base + 30*DAY bin <- window(x, start = start) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NULL")) # Test just start, end = NULL, empty range start <- base + 25 * DAY end <- base + 30*DAY bin <- window(x, start = start) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NULL, empty range")) # Test just end, start = NULL end <- base + 13 * DAY start <- base bin <- window(x, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NULL")) # Test just end, start = NULL, empty range end <- base start <- base bin <- window(x, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NULL, empty range")) # Test end = NULL, start = NULL start <- base end <- base + 30*DAY bin <- window(x) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- end = NULL, start = NULL")) # Test just start, end = NA start <- base + 13 * DAY end <- base + 30*DAY bin <- window(x, start = start, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NA")) # Test just start, end = NA, empty range start <- base + 25 * DAY end <- base + 30*DAY bin <- window(x, start = start, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just start, end = NA, empty range")) # Test just end, start = NA end <- base + 13 * DAY start <- base bin <- window(x, start = NA, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NA")) # Test just end, start = NA, empty range end <- base start <- base bin <- window(x, start = NA, end = end) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- just end, start = NA, empty range")) # Test end = NA, start = NA start <- base end <- base + 30*DAY bin <- window(x, start = NA, end = NA) reg <- window_dbg(x, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- end = NA, start = NA")) ####################################### # Test for index. parameter start <- base end <- base + 30*DAY idx = index(x)[c(2,4,6)] bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- index. parameter provided")) # Test index. outside range of dates in xts series start <- base end <- base + 30*DAY idx = c(start, index(x)[c(2,4,6)], end) bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- index. outside range of dates in xts series")) # Test NA in index start <- base end <- base + 30*DAY idx = c(start, index(x)[c(2,4,6)], end, NA) bin <- window(x, index. = idx) reg <- window_dbg(x, index. = idx, start = start, end = end) expect_identical(bin, reg, info = paste(info_msg, "- NA in index ")) # Next 3 adapted from window.zoo example # Test basic window.zoo example x.date <- as.Date(paste(2003, rep(1:4, 4:1), seq(1,19,2), sep = "-")) x <- xts(matrix(1:20, ncol = 2), x.date) bin <- window(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) reg <- window_dbg(x, start = as.Date("2003-02-01"), end = as.Date("2003-03-01")) expect_identical(bin, reg, info = paste(info_msg, "- basic window.zoo example")) # Test index + start bin <- window(x, index. = x.date[1:6], start = as.Date("2003-02-01")) reg <- window_dbg(x, index. = x.date[1:6], start = as.Date("2003-02-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- index + start")) # Test just index bin <- window(x, index. = x.date[c(4, 8, 10)]) reg <- window_dbg(x, index. = x.date[c(4, 8, 10)], start = as.Date("2003-01-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- just index")) # Test decreasing index bin <- window(x, index. = x.date[c(10, 8, 4)]) reg <- window_dbg(x, index. = x.date[c(10, 8, 4)], start = as.Date("2003-01-01"), end = as.Date("2004-01-01")) expect_identical(bin, reg, info = paste(info_msg, "- decreasing index")) # Test index parameter with repeated dates in xts series idx <- sort(rep(1:5, 5)) x <- xts(1:length(idx), as.Date("1999-12-31")+idx) bin <- window(x, index. = as.Date("1999-12-31")+c(1,3,5)) reg <- window_dbg(x, index. = as.Date("1999-12-31")+c(1,3,5), start = as.Date("2000-01-01"), end = as.Date("2000-01-05")) expect_identical(bin, reg, info = paste(info_msg, "- index parameter with repeated dates in xts series")) expect_true(nrow(bin) == 3*5, info = paste(info_msg, "- index parameter with repeated dates in xts series")) # Test performance difference DAY = 24*3600 base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20)*DAY x <- xts(1:length(dts), dts) start <- base + 14*DAY end <- base + 14*DAY #cat("\n") #print("performance:") #print("binary search") #print(system.time(replicate(1000, window(x, start = start, end = end)))) # Binary search is about 2x faster than regular #print("regular search") #print(system.time(replicate(1000, window_dbg(x, start = start, end = end)))) # test subset.xts for date subsetting by row info_msg <- "test.subset_i_datetime_or_character" base <- as.POSIXct("2000-12-31") dts <- base + c(1:10, 12:15, 17:20) * 24L * 3600L x <- xts(seq_along(dts), dts) # Note that "2001-01-11" is not in the series. Skipped by convention. d <- c("2001-01-10", "2001-01-11", "2001-01-12", "2001-01-13") for (type in c("double", "integer")) { storage.mode(.index(x)) <- type # Test scalar msg <- paste0(info_msg, " scalar, ", type, " index") bin <- window(x, start = d[1], end = d[1]) expect_identical(bin, x[d[1], ], info = paste("character", msg)) expect_identical(bin, x[I(d[1]), ], info = paste("as-is character", msg)) expect_identical(bin, x[as.POSIXct(d[1]), ], info = paste("POSIXct", msg)) expect_identical(bin, x[as.Date(d[1]), ], info = paste("Date", msg)) # Test vector msg <- paste0(info_msg, " vector, ", type, " index") bin <- window(x, start = d[1], end = d[length(d)]) expect_identical(bin, x[d, ], info = paste("character", msg)) expect_identical(bin, x[I(d), ], info = paste("as-is character", msg)) expect_identical(bin, x[as.POSIXct(d), ], info = paste("POSIXct", msg)) expect_identical(bin, x[as.Date(d), ], info = paste("Date", msg)) # Test character dates, and single column selection y <- xts(rep(2, length(dts)), dts) z <- xts(rep(3, length(dts)), dts) x2 <- cbind(y, x, z) sub <- x2[d, 2] # Note that "2001-01-11" is not in the series. Skipped by convention. bin <- window(x, start = d[1], end = d[length(d)]) expect_equal(nrow(sub), nrow(bin), info = paste(info_msg, "- character dates, and single column selection")) expect_true(all(sub == bin), info = paste(info_msg, "- character dates, and single column selection")) } info_msg <- "test.subset_i_ISO8601" x <- xts(1:1000, as.Date("2000-01-01")+1:1000) for (type in c("double", "integer")) { storage.mode(.index(x)) <- type # Test Date Ranges sub <- x['200001'] # January 2000 bin <- window(x, start = "2000-01-01", end = "2000-01-31") expect_identical(bin, sub, info = paste(info_msg, ", i = 2000-01")) # Test Date Ranges 2 sub <- x['1999/2000'] # All of 2000 (note there is no need to use the exact start) bin <- window(x, start = "2000-01-01", end = "2000-12-31") expect_identical(bin, sub, info = paste(info_msg, ", i = 1999/2000")) # Test Date Ranges 3 sub <- x['1999/200001'] # January 2000 bin <- window(x, start = "2000-01-01", end = "2000-01-31") expect_identical(bin, sub, info = paste(info_msg, ", i= 1999/2000-01")) } xts/inst/tinytest/test-xts.R0000644000176200001440000005020714522244665015664 0ustar liggesusers# Tests for xts constructors ### NA in order.by {{{ # .xts() expect_error(.xts(1:3, c(1L, 2L, NA)), info = ".xts() order.by ends with NA_integer_") expect_error(.xts(1:3, c(NA, 2L, 3L)), info = ".xts() order.by starts with NA_integer_") expect_error(.xts(1:3, c(1L, NA, 3L)), info = ".xts() order.by contains NA_integer_") expect_error(.xts(1:3, c(1, 2, NA)), info = ".xts() order.by ends with NA_real_") expect_error(.xts(1:3, c(NA, 2, 3)), info = ".xts() order.by starts with NA_real_") expect_error(.xts(1:3, c(1, NA, 3)), info = ".xts() order.by contains NA_real_") expect_error(.xts(1:3, c(1, 2, NaN)), info = ".xts() order.by ends with NaN") expect_error(.xts(1:3, c(NaN, 2, 3)), info = ".xts() order.by starts with NaN") expect_error(.xts(1:3, c(1, NaN, 3)), info = ".xts() order.by contains NaN") expect_error(.xts(1:3, c(1, 2, Inf)), info = ".xts() order.by ends with Inf") expect_error(.xts(1:3, c(-Inf, 2, 3)), info = ".xts() order.by starts with -Inf") # xts() expect_error(xts(1:3, as.Date(c(1L, 2L, NA), origin = "1970-01-01")), info = "xts() order.by ends with NA_integer_") expect_error(xts(1:3, as.Date(c(NA, 2L, 3L), origin = "1970-01-01")), info = "xts() order.by starts with NA_integer_") expect_error(xts(1:3, as.Date(c(1L, NA, 3L), origin = "1970-01-01")), info = "xts() order.by contains NA_integer_") expect_error(xts(1:3, .POSIXct(c(1, 2, NA))), info = "xts() order.by ends with NA_real_") expect_error(xts(1:3, .POSIXct(c(NA, 2, 3))), info = "xts() order.by starts with NA_real_") expect_error(xts(1:3, .POSIXct(c(1, NA, 3))), info = "xts() order.by contains NA_real_") expect_error(xts(1:3, .POSIXct(c(1, 2, NaN))), info = "xts() order.by ends with NaN") expect_error(xts(1:3, .POSIXct(c(NaN, 2, 3))), info = "xts() order.by starts with NaN") expect_error(xts(1:3, .POSIXct(c(1, NaN, 3))), info = "xts() order.by contains NaN") expect_error(xts(1:3, .POSIXct(c(1, 2, Inf))), info = "xts() order.by ends with Inf") expect_error(xts(1:3, .POSIXct(c(-Inf, 2, 3))), info = "xts() order.by starts with -Inf") ### }}} # Test that only first tzone element is stored for POSIXlt tz <- "America/Chicago" i <- as.POSIXlt("2018-01-01", tz = tz) y <- xts(1, i) expect_identical(tz, tzone(y), info = "xts() only uses the first element of tzone for POSIXlt order.by") ### constructors add tzone and tclass to the index by default x <- xts() expect_true(!is.null(attr(attr(x, "index"), "tclass")), info = "xts() with no args adds tclass to the index") expect_true(!is.null(attr(attr(x, "index"), "tzone")), info = "xts() with no args adds tzone to the index") x <- .xts(, .POSIXct(integer())) expect_true(!is.null(attr(attr(x, "index"), "tclass")), info = ".xts() with no args adds tclass to the index") expect_true(!is.null(attr(attr(x, "index"), "tzone")), info = ".xts() with no args adds tzone to the index") ### constructor defaults don't add index attributes to the xts object x <- xts(1, as.Date("2018-05-02")) expect_null(attr(x, "tclass"), info = "xts() doesn't add tclass to xts object") expect_null(attr(x, ".indexCLASS"), info = "xts() doesn't add .indexCLASS to xts object") y <- .xts(1, 1) expect_null(attr(y, "tclass"), info = ".xts() doesn't add .indexCLASS to xts object") expect_null(attr(y, ".indexCLASS"), info = ".xts() doesn't add .indexCLASS to xts object") x <- xts(1, as.Date("2018-05-02")) expect_null(attr(x, "tzone"), info = "xts() doesn't add tzone to xts object") expect_null(attr(x, ".indexTZ"), info = "xts() doesn't add .indexTZ to xts object") y <- .xts(1, 1) expect_null(attr(y, "tzone"), info = ".xts() doesn't add tzone to xts object") expect_null(attr(y, ".indexTZ"), info = ".xts() doesn't add .indexTZ to xts object") x <- xts(1, as.Date("2018-05-02")) expect_null(attr(x, "tformat"), info = "xts() doesn't add tformat to xts object") expect_null(attr(x, ".indexFORMAT"), info = "xts() doesn't add .indexFORMAT to xts object") y <- .xts(1, 1) expect_null(attr(y, "tformat"), info = ".xts() doesn't add tformat to xts object") expect_null(attr(y, ".indexFORMAT"), info = ".xts() doesn't add .indexFORMAT to xts object") ### constructor with index attributes specified doesn't add them to the xts object create_msg <- function(func, attrib) { paste0(func, "(..., ", attrib, " = 'foo' doesn't add ", attrib, " to the xts object") } suppressWarnings({ x <- xts(1, Sys.time(), .indexCLASS = "yearmon") y <- xts(1, Sys.time(), .indexFORMAT = "%Y") z <- xts(1, Sys.time(), .indexTZ = "UTC") }) expect_null(attr(x, ".indexCLASS"), info = create_msg("xts", ".indexCLASS")) expect_null(attr(y, ".indexFORMAT"), info = create_msg("xts", ".indexFORMAT")) expect_null(attr(z, ".indexTZ"), info = create_msg("xts", ".indexTZ")) suppressWarnings({ x <- .xts(1, Sys.time(), .indexCLASS = "yearmon") y <- .xts(1, Sys.time(), .indexFORMAT = "%Y") z <- .xts(1, Sys.time(), .indexTZ = "UTC") }) expect_null(attr(x, ".indexCLASS"), info = create_msg(".xts", ".indexCLASS")) expect_null(attr(y, ".indexFORMAT"), info = create_msg(".xts", ".indexFORMAT")) expect_null(attr(z, ".indexTZ"), info = create_msg(".xts", ".indexTZ")) x <- xts(1, Sys.time(), tclass = "Date") y <- xts(1, Sys.time(), tformat = "%Y-%m-%d %H:%M") z <- xts(1, Sys.time(), tzone = "UTC") expect_null(attr(x, "tclass"), info = create_msg("xts", "tclass")) expect_null(attr(y, "tformat"), info = create_msg("xts", "tformat")) expect_null(attr(z, "tzone"), info = create_msg("xts", "tzone")) x <- .xts(1, Sys.time(), tclass = "Date") y <- .xts(1, Sys.time(), tformat = "%Y-%m-%d %H:%M") z <- .xts(1, Sys.time(), tzone = "UTC") expect_null(attr(x, "tclass"), info = create_msg(".xts", "tclass")) expect_null(attr(y, "tformat"), info = create_msg(".xts", "tformat")) expect_null(attr(z, "tzone"), info = create_msg(".xts", "tzone")) # These error due to `missing("tclass")` instead of `!hasArg("tclass")` # missing() expects an argument symbol, not a character string. The error is # not caught in expect_warning() as of tinytest_1.3.1 suppressWarnings(xts(1, as.Date("2018-05-02"), .indexCLASS = "Date")) suppressWarnings(xts(1, as.Date("2018-05-02"), .indexFORMAT = "%Y")) suppressWarnings(.xts(1, 1, .indexCLASS = "Date")) suppressWarnings(.xts(1, 1, .indexFORMAT = "%Y")) ### warn if deprecated arguments passed to constructor deprecated_warns <- list(iclass = "'.indexCLASS' is deprecated.*use tclass instead", izone = "'.indexTZ' is deprecated.*use tzone instead", iformat = "'.indexFORMAT' is deprecated.*use tformat instead") expect_warning(x <- xts(1, as.Date("2018-05-02"), .indexCLASS = "Date"), pattern = deprecated_warns$iclass, info = "xts() warns when .indexCLASS argument is provided") expect_warning(x <- .xts(1, as.Date("2018-05-02"), .indexCLASS = "Date"), pattern = deprecated_warns$iclass, info = ".xts() warns when .indexCLASS argument is provided") expect_warning(x <- xts(1, as.Date("2018-05-02"), .indexTZ = "UTC"), pattern = deprecated_warns$izone, info = "xts() warns when .indexTZ argument is provided") expect_warning(x <- .xts(1, as.Date("2018-05-02"), .indexTZ = "UTC"), pattern = deprecated_warns$izone, info = ".xts() warns when .indexTZ argument is provided") expect_warning(x <- xts(1, as.Date("2018-05-02"), .indexFORMAT = "%Y"), pattern = deprecated_warns$iformat, info = "xts() warns when .indexFORMAT is provided") expect_warning(x <- .xts(1, as.Date("2018-05-02"), .indexFORMAT = "%Y"), pattern = deprecated_warns$iformat, info = ".xts() warns when .indexFORMAT is provided") ### constructors add tformat to the index when it's specified tf <- "%m/%d/%Y" x <- xts(1:3, .Date(1:3), tformat = tf) y <- .xts(1:3, .Date(1:3), tformat = tf) expect_identical(tf, attr(attr(x, "index"), "tformat"), info = "xts(..., tformat = 'foo') adds tformat to index") expect_identical(tf, attr(attr(y, "index"), "tformat"), info = ".xts(..., tformat = 'foo') adds tformat to index") ### dimnames come through '...' x <- xts(1:5, .Date(1:5), dimnames = list(NULL, "x")) y <- .xts(1:5, 1:5, dimnames = list(NULL, "x")) expect_equal(colnames(x), colnames(y), info = "xts() and .xts() apply dimnames passed via '...'") x <- xts(1:5, .Date(1:5), dimnames = list(1:5, "x")) y <- .xts(1:5, 1:5, dimnames = list(1:5, "x")) expect_null(rownames(x), info = "xts() doesn't set rownames when dimnames passed via '...'") expect_null(rownames(y), info = ".xts() doesn't set rownames when dimnames passed via '...'") m <- matrix(1, dimnames = list("a", "b")) x <- .xts(m, 1) expect_null(rownames(x), info = ".xts() on a matrix with rownames does not have rownames") # test..xts_ctor_warns_if_index_tclass_not_NULL_or_POSIXct <- function() { # DEACTIVATED("Warning causes errors in dependencies") # # idx <- 1:3 # x <- .xts(1:3, idx) # no error, NULL # idx <- .POSIXct(idx) # x <- .xts(1:3, idx) # no error, POSIXct # # idx <- structure(1:3, tclass = "Date", tzone = "UTC") # expect_warning(.xts(1:3, idx), msg = "tclass = Date") # idx <- structure(idx, tclass = "yearmon", tzone = "UTC") # expect_warning(.xts(1:3, idx), msg = "tclass = yearmon") # idx <- structure(idx, tclass = "timeDate", tzone = "UTC") # expect_warning(.xts(1:3, idx), msg = "tclass = timeDate") # } ### xts() index attribute precedence should be: ### 1. .index* value (e.g. .indexTZ) # backward compatibility ### 2. t* value (e.g. tzone) # current function to override index attribute ### 3. attribute on order.by # overridden by either 2 above target_index <- structure(Sys.time(), tzone = "UTC", tclass = "yearmon", tformat = "%Y-%m-%d") suppressWarnings({ x <- xts(1, target_index, .indexCLASS = "Date", tclass = "yearqtr") y <- xts(1, target_index, .indexFORMAT = "%Y-%b", tformat = "%Y-%m") z <- xts(1, target_index, .indexTZ = "Asia/Tokyo", tzone = "Europe/London") }) expect_identical(tclass(x), "Date", info = "xts() .indexCLASS takes precedence over tclass") expect_identical(tformat(y), "%Y-%b", info = "xts() .indexFORMAT takes precedence over tformat") expect_identical(tzone(z), "Asia/Tokyo", info = "xts() .indexTZ takes precedence over tzone") x <- xts(1, target_index, tclass = "yearqtr") y <- xts(1, target_index, tformat = "%Y-%m") z <- xts(1, target_index, tzone = "Europe/London") expect_identical(tclass(x), "yearqtr", info = "xts() tclass takes precedence over index tclass") expect_identical(tformat(y), "%Y-%m", info = "xts() tformat takes precedence over index tformat") expect_identical(tzone(z), "Europe/London", info = "xts() tzone takes precedence over index tzone") x <- xts(1, target_index) y <- xts(1, target_index) z <- xts(1, target_index) expect_identical(tclass(x), attr(target_index, "tclass"), info = "xts() uses index tclass") expect_identical(tformat(y), attr(target_index, "tformat"), info = "xts() uses index tformat") expect_identical(tzone(z), attr(target_index, "tzone"), info = "xts() uses index tzone") ### .xts() index attribute precedence is similar. But we cannot override tclass ### because it's a formal argument with a specific default. Historically .xts() ### has always set the tclass to POSIXct by default, whether or not the 'index' ### argument already had a tclass attribute. target_index <- structure(as.POSIXlt(Sys.time()), tzone = "UTC", tclass = "yearmon", tformat = "%Y-%m-%d") suppressWarnings({ x <- .xts(1, target_index, .indexCLASS = "Date", tclass = "yearqtr") y <- .xts(1, target_index, .indexFORMAT = "%Y-%b", tformat = "%Y-%m") z <- .xts(1, target_index, .indexTZ = "Asia/Tokyo", tzone = "Europe/London") }) expect_identical(tclass(x), "Date", info = ".xts() .indexCLASS takes precedence over tclass") expect_identical(tformat(y), "%Y-%b", info = ".xts() .indexFORMAT takes precedence over tformat") expect_identical(tzone(z), "Asia/Tokyo", info = ".xts() .indexTZ takes precedence over tzone") x <- .xts(1, target_index, tclass = "yearqtr") y <- .xts(1, target_index, tformat = "%Y-%m") z <- .xts(1, target_index, tzone = "Europe/London") expect_identical(tclass(x), "yearqtr", info = ".xts() tclass takes precedence over index tclass") expect_identical(tformat(y), "%Y-%m", info = ".xts() tformat takes precedence over index tformat") expect_identical(tzone(z), "Europe/London", info = ".xts() tzone takes precedence over index tzone") x <- .xts(1, target_index) y <- .xts(1, target_index) z <- .xts(1, target_index) # NOTE: as of 0.10-0, .xts() sets tclass on the index to "POSIXct" by default. # It does not keep the index argument's tclass if it has one. So overriding # the default with the index's tclass attribute is a breaking change. expect_identical(tclass(x), c("POSIXct", "POSIXt"), info = ".xts() *ignores* index tclass (unlike xts())") # tformat and tzone are handled the same as in xts() expect_identical(tformat(y), attr(target_index, "tformat"), info = ".xts() uses index tformat") expect_identical(tzone(z), attr(target_index, "tzone"), info = ".xts() uses index tzone") suppressWarnings({ x <- xts(1, Sys.Date(), tformat = "%Y", .indexCLASS = "Date", .indexTZ = "UTC", user = "attribute", hello = "world", dimnames = list(NULL, "x")) y <- .xts(1, 1, tformat = "%Y", .indexCLASS = "Date", .indexTZ = "UTC", user = "attribute", hello = "world", dimnames = list(NULL, "x")) }) info_msg <- "xts() adds user attributes" expect_null(attr(x, "tformat"), info = info_msg) expect_null(attr(x, "tclass"), info = info_msg) expect_null(attr(x, "tzone"), info = info_msg) expect_null(attr(x, ".indexCLASS"), info = info_msg) expect_null(attr(x, ".indexTZ"), info = info_msg) expect_identical("attribute", attr(x, "user"), info = info_msg) expect_identical("world", attr(x, "hello"), info = info_msg) expect_identical("x", colnames(x), info = info_msg) info_msg <- ".xts() adds user attributes" expect_null(attr(y, "tformat"), info = info_msg) expect_null(attr(y, "tclass"), info = info_msg) expect_null(attr(y, "tzone"), info = info_msg) expect_null(attr(y, ".indexCLASS"), info = info_msg) expect_null(attr(y, ".indexTZ"), info = info_msg) expect_identical("attribute", attr(y, "user"), info = info_msg) expect_identical("world", attr(y, "hello"), info = info_msg) expect_identical("x", colnames(y), info = info_msg) ### constructors should not warn for Date, yearmon, yearqtr, chron::chron, chron::dates ### and should set tzone to UTC for any UTC-equivalent tzone create_msg <- function(klass, tz, warns = TRUE) { warn_part <- if(warns) "warns" else "doesn't warn" sprintf("xts(1, %s(...), tzone = '%s') %s", klass, tz, warn_part) } create_msg. <- function(klass, tz, warns = TRUE) { paste0(".", create_msg(klass, tz, warns)) } ym <- as.yearmon(Sys.Date()) yq <- as.yearqtr(Sys.Date()) for(tz in c("UTC", "GMT", "Etc/UTC", "Etc/GMT", "GMT-0", "GMT+0", "GMT0")) { # xts() x <- y <- z <- NULL expect_silent(x <- xts(1, .Date(1), tzone = tz), info = create_msg("Date()", tz, FALSE)) expect_silent(y <- xts(1, ym, tzone = tz), info = create_msg("yearmon", tz, FALSE)) expect_silent(z <- xts(1, yq, tzone = tz), info = create_msg("yearqtr", tz, FALSE)) expect_identical(tzone(x), "UTC", info = "xts() UTC-equivalent tzone is set to UTC (Date)") expect_identical(tzone(y), "UTC", info = "xts() UTC-equivalent tzone is set to UTC (yearmon)") expect_identical(tzone(z), "UTC", info = "xts() UTC-equivalent tzone is set to UTC (yearqtr)") # .xts() x <- y <- z <- NULL expect_silent(x <- .xts(1, .Date(1), tzone = tz), info = create_msg.("Date", tz, FALSE)) expect_silent(y <- .xts(1, ym, tzone = tz), info = create_msg.("yearmon", tz, FALSE)) expect_silent(z <- .xts(1, yq, tzone = tz), info = create_msg.("yearqtr", tz, FALSE)) expect_identical(tzone(x), "UTC", info = ".xts() UTC-equivalent tzone is set to UTC (Date)") expect_identical(tzone(y), "UTC", info = ".xts() UTC-equivalent tzone is set to UTC (yearmon)") expect_identical(tzone(z), "UTC", info = ".xts() UTC-equivalent tzone is set to UTC (yearqtr)") if(requireNamespace("chron", quietly = TRUE)) { x <- y <- NULL expect_silent(x <- xts(1, chron::chron(1, 1), tzone = tz), info = create_msg("chron", tz, FALSE)) expect_silent(y <- xts(1, chron::dates(1), tzone = tz), info = create_msg("dates", tz, FALSE)) expect_identical(tzone(x), "UTC", info = "xts() UTC-equivalent tzone is set to UTC (chron)") expect_identical(tzone(y), "UTC", info = ".xts() UTC-equivalent tzone is set to UTC (dates)") x <- y <- NULL expect_silent(x <- .xts(1, chron::chron(1, 1), tzone = tz), info = create_msg.("chron", tz, FALSE)) expect_silent(y <- .xts(1, chron::dates(1), tzone = tz), info = create_msg.("dates", tz, FALSE)) expect_identical(tzone(x), "UTC", info = "xts() UTC-equivalent tzone is set to UTC (chron)") expect_identical(tzone(y), "UTC", info = ".xts() UTC-equivalent tzone is set to UTC (dates)") } } ### constructors warn and ignore non-UTC tzone for index/order.by classes without timezones tz <- "America/Chicago" warn_pattern <- "tzone.*setting ignored for.*indexes" # xts() x <- y <- z <- NULL expect_warning(x <- xts(1, .Date(1), tzone = tz), pattern = warn_pattern, info = create_msg("Date", tz, TRUE)) expect_warning(y <- xts(1, ym, tzone = tz), pattern = warn_pattern, info = create_msg("yearmon", tz, TRUE)) expect_warning(z <- xts(1, yq, tzone = tz), pattern = warn_pattern, info = create_msg("yearqtr", tz, TRUE)) expect_identical(tzone(x), "UTC", info = "xts() non-UTC tzone is set to UTC (Date)") expect_identical(tzone(y), "UTC", info = "xts() non-UTC tzone is set to UTC (yearmon)") expect_identical(tzone(z), "UTC", info = "xts() non-UTC tzone is set to UTC (yearqtr)") # .xts() x <- y <- z <- NULL expect_warning(x <- .xts(1, .Date(1), tzone = tz), pattern = warn_pattern, info = create_msg("yearqtr", tz, TRUE)) expect_warning(y <- .xts(1, ym, tzone = tz), pattern = warn_pattern, info = create_msg("Date", tz, TRUE)) expect_warning(z <- .xts(1, yq, tzone = tz), pattern = warn_pattern, info = create_msg("yearmon", tz, TRUE)) expect_identical(tzone(x), "UTC", info = ".xts() non-UTC tzone is set to UTC (Date)") expect_identical(tzone(y), "UTC", info = ".xts() non-UTC tzone is set to UTC (yearmon)") expect_identical(tzone(z), "UTC", info = ".xts() non-UTC tzone is set to UTC (yearqtr)") if(requireNamespace("chron", quietly = TRUE)) { x <- y <- NULL expect_warning(x <- xts(1, chron::chron(1, 1), tzone = tz), pattern = warn_pattern, info = create_msg("chron", tz, TRUE)) expect_warning(y <- xts(1, chron::dates(1), tzone = tz), pattern = warn_pattern, info = create_msg("dates", tz, TRUE)) expect_identical(tzone(x), "UTC", info = "xts() non-UTC tzone is set to UTC (chron)") expect_identical(tzone(y), "UTC", info = "xts() non-UTC tzone is set to UTC (dates)") x <- y <- NULL expect_warning(x <- .xts(1, chron::chron(1, 1), tzone = tz), pattern = warn_pattern, info = create_msg.("chron", tz, TRUE)) expect_warning(y <- .xts(1, chron::dates(1), tzone = tz), pattern = warn_pattern, info = create_msg.("dates", tz, TRUE)) expect_identical(tzone(x), "UTC", info = ".xts() non-UTC tzone is set to UTC (chron)") expect_identical(tzone(y), "UTC", info = ".xts() non-UTC tzone is set to UTC (dates)") } ### lists and zero-row data.frames msg <- "cannot convert lists to xts objects" expect_error(xts(list(1, 2), .Date(1:2)), msg, info = msg) #expect_error(.xts(list(1, 2), 1:2), msg, info = msg) zero_row_df <- data.frame(date = .Date(numeric(0)), x = numeric(0), y = numeric(0)) zero_row_xts <- xts(zero_row_df[, -1], zero_row_df[, 1]) expect_identical(names(zero_row_xts), names(zero_row_df)[-1], info = "xts() keeps names for zero-row data.frame") expect_equal(.Date(numeric(0)), index(zero_row_xts), info = "xts() has zero-length Date index for zero-row data.frame with Date column") zero_row_xts. <- .xts(zero_row_df[, -1], zero_row_df[, 1]) expect_identical(names(zero_row_xts.), names(zero_row_df)[-1], info = ".xts() keeps names for zero-row data.frame") expect_equal(.Date(numeric(0)), index(zero_row_xts.), info = ".xts() has zero-length Date index for zero-row data.frame with Date column") xts/inst/tinytest/test-isordered.R0000644000176200001440000000554614522244665017034 0ustar liggesusers# Tests for isOrdered() # Utility functions for tests {{{ check.isOrdered <- function(x, v = rep(TRUE, 4), msg = "") { xc <- paste(capture.output(dput(x)), collapse = " ") expect_identical(v[1], isOrdered(x, TRUE, TRUE), info = paste(msg, xc, v[1], "increasing, strictly")) expect_identical(v[2], isOrdered(x, TRUE, FALSE), info = paste(msg, xc, v[2], "increasing")) expect_identical(v[3], isOrdered(x, FALSE, FALSE), info = paste(msg, xc, v[3], "decreasing")) expect_identical(v[4], isOrdered(x, FALSE, TRUE), info = paste(msg, xc, v[4], "decreasing, strictly")) } # }}} TTTT <- rep(TRUE, 4) FFFF <- !TTTT TTFF <- c(TRUE, TRUE, FALSE, FALSE) FFTT <- !TTFF # Increasing {{{ info_msg <- "test.isOrdered_incr" check.isOrdered(1:3, TTFF, info_msg) check.isOrdered(-1:1, TTFF, info_msg) check.isOrdered(c(1, 2, 3), TTFF, info_msg) check.isOrdered(c(-1, 0, 1), TTFF, info_msg) ### NA, NaN, Inf # beg info_msg <- "test.isOrdered_incr_begNA" check.isOrdered(c(NA_integer_, 1L, 2L), FFFF, info_msg) check.isOrdered(c(NA_real_, 1, 2), TTFF, info_msg) check.isOrdered(c(NaN, 1, 2), TTFF, info_msg) check.isOrdered(c(Inf, 1, 2), FFFF, info_msg) check.isOrdered(c(-Inf, 1, 2), TTFF, info_msg) # mid info_msg <- "test.isOrdered_incr_midNA" check.isOrdered(c(1L, NA_integer_, 2L), FFFF, info_msg) check.isOrdered(c(1, NA_real_, 2), TTTT, info_msg) check.isOrdered(c(1, NaN, 2), TTTT, info_msg) check.isOrdered(c(1, Inf, 2), FFFF, info_msg) check.isOrdered(c(1, -Inf, 2), FFFF, info_msg) # end info_msg <- "test.isOrdered_incr_endNA" check.isOrdered(c(1L, 2L, NA_integer_), TTFF, info_msg) check.isOrdered(c(1, 2, NA_real_), TTFF, info_msg) check.isOrdered(c(1, 2, NaN), TTFF, info_msg) check.isOrdered(c(1, 2, Inf), TTFF, info_msg) check.isOrdered(c(1, 2, -Inf), FFFF, info_msg) ### # }}} # Decreasing {{{ info_msg <- "test.isOrdered_decr" check.isOrdered(1:-1, FFTT, info_msg) check.isOrdered(3:1, FFTT, info_msg) check.isOrdered(c(3, 2, 1), FFTT, info_msg) check.isOrdered(c(1, 0, -1), FFTT, info_msg) ### NA, NaN, Inf # beg info_msg <- "test.isOrdered_decr_begNA" check.isOrdered(c(NA_integer_, 2L, 1L), FFTT, info_msg) check.isOrdered(c(NA_real_, 2, 1), FFTT, info_msg) check.isOrdered(c(NaN, 2, 1), FFTT, info_msg) check.isOrdered(c(Inf, 2, 1), FFTT, info_msg) check.isOrdered(c(-Inf, 2, 1), FFFF, info_msg) # mid info_msg <- "test.isOrdered_decr_midNA" check.isOrdered(c(2L, NA_integer_, 1L), FFFF, info_msg) check.isOrdered(c(2, NA_real_, 1), TTTT, info_msg) check.isOrdered(c(2, NaN, 1), TTTT, info_msg) check.isOrdered(c(2, Inf, 1), FFFF, info_msg) check.isOrdered(c(2, -Inf, 1), FFFF, info_msg) # end info_msg <- "test.isOrdered_decr_endNA" check.isOrdered(c(2L, 1L, NA_integer_), FFFF, info_msg) check.isOrdered(c(2, 1, NA_real_), FFTT, info_msg) check.isOrdered(c(2, 1, NaN), FFTT, info_msg) check.isOrdered(c(2, 1, Inf), FFFF, info_msg) check.isOrdered(c(2, 1, -Inf), FFTT, info_msg) ### # }}} xts/inst/tinytest/test-period.apply.R0000644000176200001440000000754114525744640017460 0ustar liggesusers# period.apply() doesn't care what generates the INDEX, # but it does care that INDEX has the following characteristics: # 1) the first element is zero, # 2) the last element is nrow(x), # 3) there are no duplicate elements, # 4) the elements are sorted. # info_msg <- "test.duplicate_INDEX" x <- .xts(1:10, 1:10) ep <- c(0, 2, 4, 6, 8, 10) nodup <- period.apply(x, ep, sum) dup <- period.apply(x, c(ep, 10), sum) expect_identical(nodup, dup, info = info_msg) info_msg <- "test.duplicate_INDEX_vector" x <- 1:10 ep <- c(0, 2, 4, 6, 8, 10) nodup <- period.apply(x, ep, sum) dup <- period.apply(x, c(ep, 10), sum) expect_identical(nodup, dup, info = info_msg) info_msg <- "test.unsorted_INDEX" x <- .xts(1:10, 1:10) ep.s <- c(2, 4, 6, 8) ep.u <- sample(ep.s) s <- period.apply(x, c(0, ep.s, 10), sum) u <- period.apply(x, c(0, ep.u, 10), sum) expect_identical(s, u, info = info_msg) info_msg <- "test.unsorted_INDEX_vector" x <- 1:10 ep.s <- c(2, 4, 6, 8) ep.u <- sample(ep.s) s <- period.apply(x, c(0, ep.s, 10), sum) u <- period.apply(x, c(0, ep.u, 10), sum) expect_identical(s, u, info = info_msg) info_msg <- "test.INDEX_starts_with_zero" x <- .xts(1:10, 1:10) ep <- c(2, 4, 6, 8, 10) a <- period.apply(x, ep, sum) z <- period.apply(x, c(0, ep), sum) expect_identical(a, z, info = info_msg) info_msg <- "test.INDEX_starts_with_zero_vector" x <- 1:10 ep <- c(2, 4, 6, 8, 10) a <- period.apply(x, ep, sum) z <- period.apply(x, c(0, ep), sum) expect_identical(a, z, info = info_msg) info_msg <- "test.INDEX_ends_with_lengthX" x <- .xts(1:10, 1:10) ep <- c(0, 2, 4, 6, 8) a <- period.apply(x, ep, sum) z <- period.apply(x, c(ep, 10), sum) expect_identical(a, z, info = info_msg) info_msg <- "test.INDEX_ends_with_lengthX_vector" x <- 1:10 ep <- c(0, 2, 4, 6, 8) a <- period.apply(x, ep, sum) z <- period.apply(x, c(ep, 10), sum) expect_identical(a, z, info = info_msg) # check specific period.* functions data(sample_matrix) x <- as.xts(sample_matrix[,1], dateFormat = "Date") e <- endpoints(x, "months") info_msg <- "test.period.min_equals_apply.monthly" # min am <- apply.monthly(x, min) pm <- period.min(x, e) expect_equivalent(am, pm, info = info_msg) info_msg <- "test.period.max_equals_apply.monthly" # max am <- apply.monthly(x, max) pm <- period.max(x, e) expect_equivalent(am, pm, info = info_msg) info_msg <- "test.period.sum_equals_apply.monthly" # sum am <- apply.monthly(x, sum) pm <- period.sum(x, e) expect_equivalent(am, pm, info = info_msg) info_msg <- "test.period.prod_equals_apply.monthly" # prod am <- apply.monthly(x, prod) pm <- period.prod(x, e) expect_equivalent(am, pm, info = info_msg) # test that non-integer INDEX is converted to integer info_msg <- "test.period.min_converts_index_to_integer" storage.mode(e) <- "numeric" pm <- period.min(x, e) info_msg <- "test.period.max_converts_index_to_integer" storage.mode(e) <- "numeric" pm <- period.max(x, e) info_msg <- "test.period.sum_converts_index_to_integer" storage.mode(e) <- "numeric" pm <- period.sum(x, e) info_msg <- "test.period.prod_converts_index_to_integer" storage.mode(e) <- "numeric" pm <- period.prod(x, e) # test conversion from intraday to daily or lower frequency info_msg <- "test.intraday_to_daily" set.seed(21) i <- as.POSIXct("2013-02-05 01:01", tz = "America/Chicago") x <- xts(rnorm(10000), i - 10000:1 * 60) d <- to.daily(x) dateseq <- seq(as.Date("2013-01-29"), as.Date("2013-02-05"), "day") expect_equivalent(index(d), dateseq, info = info_msg) # message for FUN = mean expect_message(period.apply(x, e, mean), pattern = "period\\.apply\\(..., FUN = mean\\)") expect_message(apply.daily(x, mean), pattern = "apply\\.daily\\(..., FUN = mean\\)") expect_message(apply.monthly(x, mean), pattern = "apply\\.monthly\\(..., FUN = mean\\)") expect_message(apply.quarterly(x, mean), pattern = "apply\\.quarterly\\(..., FUN = mean\\)") expect_message(apply.yearly(x, mean), pattern = "apply\\.yearly\\(..., FUN = mean\\)") xts/inst/tinytest/test-endpoints.R0000644000176200001440000002406614522244665017055 0ustar liggesusers# index crosses the unix epoch info_msg <- "test.double_index_cross_epoch" x <- .xts(1:22, 1.0*(-10:11), tzone="UTC") ep <- endpoints(x, "seconds", 2) expect_identical(ep, 0:11*2L, info_msg) info_msg <- "test.integer_index_cross_epoch" x <- .xts(1:22, -10:11, tzone="UTC") ep <- endpoints(x, "seconds", 2) expect_identical(ep, 0:11*2L, info_msg) #{{{daily data data(sample_matrix) xDailyDblIdx <- as.xts(sample_matrix, dateFormat="Date") xDailyIntIdx <- xDailyDblIdx storage.mode(.index(xDailyIntIdx)) <- "integer" info_msg <- "test.days_double_index" ep <- endpoints(xDailyDblIdx, "days", 7) expect_identical(ep, c(0L, 1:26*7L-3L, nrow(xDailyDblIdx)), info_msg) info_msg <- "test.days_integer_index" ep <- endpoints(xDailyIntIdx, "days", 7) expect_identical(ep, c(0L, 1:26*7L-3L, nrow(xDailyIntIdx)), info_msg) info_msg <- "test.weeks_double_index" ep <- endpoints(xDailyDblIdx, "weeks", 1) expect_identical(ep, c(0L, 1:25*7L-1L, nrow(xDailyDblIdx)), info_msg) info_msg <- "test.weeks_integer_index" ep <- endpoints(xDailyIntIdx, "weeks", 1) expect_identical(ep, c(0L, 1:25*7L-1L, nrow(xDailyIntIdx)), info_msg) info_msg <- "test.months_double_index" ep <- endpoints(xDailyDblIdx, "months", 1) expect_identical(ep, c(0L, 30L, 58L, 89L, 119L, 150L, 180L), info_msg) info_msg <- "test.months_integer_index" ep <- endpoints(xDailyIntIdx, "months", 1) expect_identical(ep, c(0L, 30L, 58L, 89L, 119L, 150L, 180L), info_msg) info_msg <- "test.quarters_double_index" ep <- endpoints(xDailyDblIdx, "quarters", 1) expect_identical(ep, c(0L, 89L, 180L), info_msg) info_msg <- "test.quarters_integer_index" ep <- endpoints(xDailyIntIdx, "quarters", 1) expect_identical(ep, c(0L, 89L, 180L), info_msg) info_msg <- "test.years_double_index" d <- seq(as.Date("1970-01-01"), by="1 day", length.out=365*5) x <- xts(seq_along(d), d) ep <- endpoints(x, "years", 1) expect_identical(ep, c(0L, 365L, 730L, 1096L, 1461L, 1825L), info_msg) info_msg <- "test.years_integer_index" d <- seq(as.Date("1970-01-01"), by="1 day", length.out=365*5) x <- xts(seq_along(d), d) storage.mode(.index(x)) <- "integer" ep <- endpoints(x, "years", 1) expect_identical(ep, c(0L, 365L, 730L, 1096L, 1461L, 1825L), info_msg) #}}} #{{{second data n <- 86400L %/% 30L * 365L * 2L xSecIntIdx <- .xts(1L:n, seq(.POSIXct(0, tz="UTC"), by="30 sec", length.out=n), tzone="UTC") xSecDblIdx <- xSecIntIdx storage.mode(.index(xSecDblIdx)) <- "double" info_msg <- "test.seconds_double_index" ep <- endpoints(xSecDblIdx, "seconds", 3600) expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg) info_msg <- "test.seconds_integer_index" ep <- endpoints(xSecIntIdx, "seconds", 3600) expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg) info_msg <- "test.seconds_secs" x <- .xts(1:10, 1:10/6) ep1 <- endpoints(x, "seconds") ep2 <- endpoints(x, "secs") expect_identical(ep1, ep2, info_msg) info_msg <- "test.minutes_double_index" ep <- endpoints(xSecDblIdx, "minutes", 60) expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg) info_msg <- "test.minutes_integer_index" ep <- endpoints(xSecIntIdx, "minutes", 60) expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg) info_msg <- "test.minutes_mins" x <- .xts(1:10, 1:10*10) ep1 <- endpoints(x, "minutes") ep2 <- endpoints(x, "mins") expect_identical(ep1, ep2, info_msg) info_msg <- "test.hours_double_index" ep <- endpoints(xSecDblIdx, "hours", 1) expect_identical(ep, seq(0L, nrow(xSecDblIdx), 120L), info_msg) info_msg <- "test.hours_integer_index" ep <- endpoints(xSecIntIdx, "hours", 1) expect_identical(ep, seq(0L, nrow(xSecIntIdx), 120L), info_msg) info_msg <- "test.days_double_index" ep <- endpoints(xSecDblIdx, "days", 1) expect_identical(ep, seq(0L, by=2880L, length.out=length(ep)), info_msg) info_msg <- "test.days_integer_index" ep <- endpoints(xSecIntIdx, "days", 1) expect_identical(ep, seq(0L, by=2880L, length.out=length(ep)), info_msg) info_msg <- "test.weeks_double_index" ep <- endpoints(xSecDblIdx, "weeks", 1) ep2 <- c(0L, seq(11520L, nrow(xSecDblIdx)-1L, 20160L), nrow(xSecDblIdx)) expect_identical(ep, ep2, info_msg) info_msg <- "test.weeks_integer_index" ep <- endpoints(xSecIntIdx, "weeks", 1) ep2 <- c(0L, seq(11520L, nrow(xSecIntIdx)-1L, 20160L), nrow(xSecIntIdx)) expect_identical(ep, ep2, info_msg) info_msg <- "test.months_double_index" ep <- endpoints(xSecDblIdx, "months", 1) n <- 86400L * c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) / 30 ep2 <- as.integer(cumsum(c(0L, n, n))) expect_identical(ep, ep2, info_msg) info_msg <- "test.months_integer_index" ep <- endpoints(xSecIntIdx, "months", 1) n <- 86400L * c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) / 30 ep2 <- as.integer(cumsum(c(0L, n, n))) expect_identical(ep, ep2, info_msg) info_msg <- "test.quarters_double_index" ep <- endpoints(xSecDblIdx, "quarters", 1) n <- 86400L * c(90, 91, 92, 92) / 30 ep2 <- as.integer(cumsum(c(0L, n, n))) expect_identical(ep, ep2, info_msg) info_msg <- "test.quarters_integer_index" ep <- endpoints(xSecIntIdx, "quarters", 1) n <- 86400L * c(90, 91, 92, 92) / 30 ep2 <- as.integer(cumsum(c(0L, n, n))) expect_identical(ep, ep2, info_msg) info_msg <- "test.years_double_index" ep <- endpoints(xSecDblIdx, "years", 1) expect_identical(ep, c(0L, 1051200L, 2102400L), info_msg) info_msg <- "test.years_integer_index" ep <- endpoints(xSecIntIdx, "years", 1) expect_identical(ep, c(0L, 1051200L, 2102400L), info_msg) #}}} # sparse endpoints could be a problem with POSIXlt elements (#169) # TODO: sparse intraday endpoints info_msg <- "test.sparse_years" x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6))) ep <- endpoints(x, "years") expect_identical(ep, 0:5, info_msg) info_msg <- "test.sparse_quarters" x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6))) ep <- endpoints(x, "quarters") expect_identical(ep, 0:5, info_msg) info_msg <- "test.sparse_months" x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6))) ep <- endpoints(x, "months") expect_identical(ep, 0:5, info_msg) info_msg <- "test.sparse_weeks" x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6))) ep <- endpoints(x, "weeks") expect_identical(ep, 0:5, info_msg) info_msg <- "test.sparse_days" x <- xts(2:6, as.Date(sprintf("199%d-06-01", 2:6))) ep <- endpoints(x, "days") expect_identical(ep, 0:5, info_msg) # sub-second resolution on Windows info_msg <- "test.sub_second_resolution" x <- .xts(1:6, .POSIXct(0:5 / 10 + 0.01)) ep <- endpoints(x, "ms", 250) expect_identical(ep, c(0L, 3L, 5L, 6L), info_msg) # precision issues info_msg <- "test.sub_second_resolution_exact" x <- .xts(1:6, .POSIXct(0:5 / 10)) ep <- endpoints(x, "ms", 250) expect_identical(ep, c(0L, 3L, 5L, 6L), info_msg) info_msg <- "test.sub_second_resolution_representation" x <- .xts(1:10, .POSIXct(1.5e9 + 0:9 / 10)) ep <- endpoints(x, "ms", 200) expect_identical(ep, seq(0L, 10L, 2L), info_msg) # on = "quarters", k > 1 info_msg <- "test.multiple_quarters" x <- xts(1:48, as.yearmon("2015-01-01") + 0:47 / 12) expect_identical(endpoints(x, "quarters", 1), seq(0L, 48L, 3L), info_msg) expect_identical(endpoints(x, "quarters", 2), seq(0L, 48L, 6L), info_msg) expect_identical(endpoints(x, "quarters", 3), c(seq(0L, 48L, 9L), 48L), info_msg) expect_identical(endpoints(x, "quarters", 4), seq(0L, 48L,12L), info_msg) expect_identical(endpoints(x, "quarters", 5), c(seq(0L, 48L,15L), 48L), info_msg) expect_identical(endpoints(x, "quarters", 6), c(seq(0L, 48L,18L), 48L), info_msg) # end(x) always in endpoints(x) result info_msg <- "test.last_obs_always_in_output" N <- 341*12 xx <- xts(rnorm(N), seq(Sys.Date(), by = "day", length.out = N)) ep <- endpoints(xx, on = "quarters", k = 2) # OK expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=2")) ep <- endpoints(xx, on = "quarters", k = 3) # NOPE expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=3")) ep <- endpoints(xx, on = "quarters", k = 4) # NOPE expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=4")) ep <- endpoints(xx, on = "quarters", k = 5) # NOPE expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "quarters, k=5")) ep <- endpoints(xx, on = "months", k = 2) # NOPE expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=2")) ep <- endpoints(xx, on = "months", k = 3) # OK expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=3")) ep <- endpoints(xx, on = "months", k = 4) # NOPE expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "months, k=4")) # For the "weeks" case works fine ep <- endpoints(xx, on = "weeks", k = 2) # OK expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=2")) ep <- endpoints(xx, on = "weeks", k = 3) # OK expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=3")) ep <- endpoints(xx, on = "weeks", k = 4) # OK expect_identical(end(xx), end(xx[ep,]), paste(info_msg, "weeks, k=4")) info_msg <- "test.k_less_than_1_errors" x <- xDailyIntIdx expect_error(endpoints(x, on = "years", k = 0), info = info_msg) expect_error(endpoints(x, on = "years", k = -1), info = info_msg) expect_error(endpoints(x, on = "quarters", k = 0), info = info_msg) expect_error(endpoints(x, on = "quarters", k = -1), info = info_msg) expect_error(endpoints(x, on = "months", k = 0), info = info_msg) expect_error(endpoints(x, on = "months", k = -1), info = info_msg) expect_error(endpoints(x, on = "weeks", k = 0), info = info_msg) expect_error(endpoints(x, on = "weeks", k = -1), info = info_msg) expect_error(endpoints(x, on = "days", k = 0), info = info_msg) expect_error(endpoints(x, on = "days", k = -1), info = info_msg) x <- xSecIntIdx expect_error(endpoints(x, on = "hours", k = 0), info = info_msg) expect_error(endpoints(x, on = "hours", k = -1), info = info_msg) expect_error(endpoints(x, on = "minutes", k = 0), info = info_msg) expect_error(endpoints(x, on = "minutes", k = -1), info = info_msg) expect_error(endpoints(x, on = "seconds", k = 0), info = info_msg) expect_error(endpoints(x, on = "seconds", k = -1), info = info_msg) x <- .xts(1:10, sort(1 + runif(10))) expect_error(endpoints(x, on = "ms", k = 0), info = info_msg) expect_error(endpoints(x, on = "ms", k = -1), info = info_msg) expect_error(endpoints(x, on = "us", k = 0), info = info_msg) expect_error(endpoints(x, on = "us", k = -1), info = info_msg) xts/inst/tinytest/test-diff.R0000644000176200001440000000356014522244665015756 0ustar liggesusers# POSIXct index info_msg <- "test.diff_integer_POSIXt" x <- .xts(1:5, 1:5 + 0.0) dx <- xts(rbind(NA_integer_, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) info_msg <- "test.diff_numeric_POSIXt" x <- .xts(1:5 + 1.0, 1:5 + 0.0) dx <- xts(rbind(NA_real_, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) info_msg <- "test.diff_logical_POSIXt" x <- .xts(1:5 > 2, 1:5 + 0.0) dx <- xts(rbind(NA, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) # Date index info_msg <- "test.diff_integer_Date" x <- xts(1:5, as.Date("2016-01-01") - 5:1) dx <- xts(rbind(NA_integer_, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) info_msg <- "test.diff_numeric_Date" x <- xts(1:5 + 1.0, as.Date("2016-01-01") - 5:1) dx <- xts(rbind(NA_real_, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) info_msg <- "test.diff_logical_Date" x <- xts(1:5 > 2, as.Date("2016-01-01") - 5:1) dx <- xts(rbind(NA, diff(coredata(x))), index(x)) expect_identical(diff(x), dx, info_msg) # Type-check failure errors info_msg <- "diff.xts() 'differences' argument must be integer" x <- .xts(1:5, 1:5) # (ignore NA introduced by coercion) expect_error(suppressWarnings(diff(x, 1L, "a")), info = info_msg) info_msg <- "diff.xts() 'lag' argument must be integer" x <- .xts(1:5, 1:5) # (ignore NA introduced by coercion) expect_error(suppressWarnings(diff(x, "a", 1L)), info = info_msg) info_msg <- "diff.xts() differences argument must be > 0" expect_error(diff(.xts(1:5, 1:5), 1L, -1L), info = info_msg) info_msg <- "diff.xts() lag argument must be > 0" expect_error(diff(.xts(1:5, 1:5), -1L, 1L), info = info_msg) info_msg <- "test.diff_logical_preserves_colnames" cnames <- c("a", "b") x <- .xts(matrix(rnorm(10) > 0, 5), 1:5, dimnames = list(NULL, cnames)) y <- diff(x) expect_identical(colnames(y), cnames, info = info_msg) xts/inst/tinytest/test-align.time.R0000644000176200001440000000462214522244665017075 0ustar liggesusers# make.index.unique info_msg <- "make.index.unique() uses 1 microsecond epsilon by default" x <- .xts(1:5, rep(1e-6, 5)) y <- make.index.unique(x) expect_equivalent(target = cumsum(rep(1e-6, 5)), current = .index(y), info = info_msg) info_msg <- "make.index.unique() warns when index value will be overwritten" x <- .xts(1:5, c(rep(1e-6, 4), 3e-6)) expect_warning(make.index.unique(x, eps = 1e-6), pattern = "index value is unique but will be replaced", info = info_msg) info_msg <- "make.index.unique() returns unique and sorted index" expect_equivalent(target = cumsum(rep(1e-6, 5)), current = .index(y), info = info_msg) info_msg <- "test.make.index.unique_adds_eps_to_duplicates" epsilon <- c(1e-6, 1e-7, 1e-8) for (eps in epsilon) { x <- .xts(1:5, rep(eps, 5)) y <- make.index.unique(x, eps = eps) expect_equivalent(target = .index(y), current = cumsum(rep(eps, 5)), info = info_msg) } info_msg <- "test.make.index.unique_no_warn_if_unique_timestamps_unchanged" x <- .xts(1:10, c(rep(1e-6, 9), 1e-5)) y <- make.index.unique(x, eps = 1e-6) expect_equivalent(target = .index(y), current = cumsum(rep(1e-6, 10)), info = info_msg) # There should be a warning if the cumulative epsilon for a set of duplicate # index values is larger than the first unique index value that follows. # When this happens, we will overwrite that non-duplicate index value with # the prior index value + eps. info_msg <- "test.make.index.unique_warns_if_unique_timestamp_changes" x <- .xts(1:5, c(rep(0, 4), 2e-6)) expect_warning(make.index.unique(x, eps = 1e-6)) # There should be a warning if the cumulative epsilon for a set of duplicate # index values is larger than the first unique index value that follows. # When this happens, we will overwrite that non-duplicate index value with # the prior index value + eps. info_msg <- "test.make.index.unique_warns_ONCE_if_unique_timestamp_changes" x <- .xts(1:5, c(rep(0, 3), 2, 3) * 1e-6) count <- 0L expect_warning(make.index.unique(x, eps = 1e-6)) info_msg <- "test.make.index.unique_converts_date_index_to_POSIXct" # It doesn't make sense to add a small epsilon to a date index. The C code # converts the integer index to a double, but it keeps the same index class. # The index class should be converted to POSIXct. xts/inst/tinytest/test-na.locf.R0000644000176200001440000001202114522244665016356 0ustar liggesusersxdata <- .xts(c(1, NA, 3, 4, 5, 6), c(0, 4, 10, 19, 24, 29)) xdata2 <- merge(one = xdata, two = xdata) xindex <- .xts(rep(0, 5), c(5, 10, 20, 25, 28)) types <- c("double", "integer", "character", "logical") ### na.locf.xts() on a univariate xts object info_msg <- "test.nalocf" for (type in types) { xdat <- xdata storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat) z <- na.locf(zdat) #expect_identical(x, as.xts(z)) # FALSE (attribute order differs) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_leading_NA" for (type in types) { xdat <- xdata storage.mode(xdat) <- type zdat <- as.zoo(xdat) xdat[1] <- NA zdat[1] <- NA x <- na.locf(xdat, na.rm = TRUE) z <- na.locf(zdat, na.rm = TRUE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) x <- na.locf(xdat, na.rm = FALSE) z <- na.locf(zdat, na.rm = FALSE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_fromLast" for (type in types) { xdat <- xdata storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat, fromLast = TRUE) z <- na.locf(zdat, fromLast = TRUE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_x" for (type in types) { xdat <- xdata xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) xidx <- rbind(xidx, .xts(vector(type, 1), 30)) zidx <- as.zoo(xidx) x <- na.locf(xdat, x = index(xidx)) z <- na.locf(zdat, x = index(zidx)) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_xout" for (type in types) { xdat <- xdata xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) x <- na.locf(xdat, xout = index(xidx)) z <- na.locf(zdat, xout = index(zidx)) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } ### na.locf.xts() on a multivariate xts object info_msg <- "test.nalocf_by_column" for (type in types) { xdat <- xdata2 storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat) z <- na.locf(zdat) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_leading_NA" for (type in types) { xdat <- xdata2 storage.mode(xdat) <- type zdat <- as.zoo(xdat) xdat[1] <- NA zdat[1] <- NA if (FALSE) { ### bug w/zoo causes this to fail ### zoo:::na.locf.default() does not remove the first row x <- na.locf(xdat, na.rm = TRUE) z <- na.locf(zdat, na.rm = TRUE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } x <- na.locf(xdat, na.rm = FALSE) z <- na.locf(zdat, na.rm = FALSE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_fromLast" for (type in types) { xdat <- xdata2 storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat, fromLast = TRUE) z <- na.locf(zdat, fromLast = TRUE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_x" for (type in types) { xdat <- xdata2 xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) xidx <- rbind(xidx, .xts(vector(type, 1), 30)) zidx <- as.zoo(xidx) x <- na.locf(xdat, x = index(xidx)) z <- na.locf(zdat, x = index(zidx)) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_xout" for (type in types) { xdat <- xdata2 xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) x <- na.locf(xdat, xout = index(xidx)) z <- na.locf(zdat, xout = index(zidx)) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_1NA" narow <- 1L for (type in types) { xdrow <- xdata2[narow,] xdat <- xdata2 * NA xdat[narow,] <- xdrow storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat) z <- na.locf(zdat) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_by_column_1NA_fromLast" narow <- nrow(xdata2) for (type in types) { xdrow <- xdata2[narow,] xdat <- xdata2 * NA xdat[narow,] <- xdrow storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat, fromLast = TRUE) z <- na.locf(zdat, fromLast = TRUE) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_first_column_all_NA" nacol <- 1L for (type in types) { xdat <- xdata2 xdat[,nacol] <- xdat[,nacol] * NA storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat) z <- na.locf(zdat) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.nalocf_last_column_all_NA" nacol <- NCOL(xdata2) for (type in types) { xdat <- xdata2 xdat[,nacol] <- xdat[,nacol] * NA storage.mode(xdat) <- type zdat <- as.zoo(xdat) x <- na.locf(xdat) z <- na.locf(zdat) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } xts/inst/tinytest/test-parseISO8601.R0000644000176200001440000000746514522244665017062 0ustar liggesusers# Constants TZ <- "UTC" START_N <- 1424390400 START_T <- .POSIXct(START_N, "UTC") END_N <- 1425168000 END_T <- .POSIXct(1425168000, "UTC") ### Test basic functionality for dates (TODO: date-times) info_msg <- "test.all_dates" out <- list(first.time = START_T, last.time = END_T) y <- .parseISO8601("/", START_N, END_N, "UTC") expect_identical(y, out, info = info_msg) y <- .parseISO8601("::", START_N, END_N, "UTC") expect_identical(y, out, info = info_msg) info_msg <- "test.start_to_right_open" y <- .parseISO8601("2015-02-21/", START_N, END_N, "UTC") start_t <- as.POSIXct("2015-02-21", tz = "UTC") expect_identical(y, list(first.time = start_t, last.time = END_T), info = info_msg) info_msg <- "test.left_open_to_end" y <- .parseISO8601("/2015-02-21", START_N, END_N, "UTC") end_t <- as.POSIXct("2015-02-22", tz = "UTC") - 1e-5 expect_identical(y, list(first.time = START_T, last.time = end_t), info = info_msg) info_msg <- "test.left_open_to_end" y <- .parseISO8601("/2015-02-21", START_N, END_N, "UTC") end_t <- as.POSIXct("2015-02-22", tz = "UTC") - 1e-5 expect_identical(y, list(first.time = START_T, last.time = end_t), info = info_msg) info_msg <- "test.single_date" y <- .parseISO8601("2015-02-21", START_N, END_N, "UTC") start_t <- as.POSIXct("2015-02-21", tz = "UTC") end_t <- as.POSIXct("2015-02-22", tz = "UTC") - 1e-5 expect_identical(y, list(first.time = start_t, last.time = end_t), info = info_msg) ### Test expected failures ### These don't produce errors, but instead return values in UNKNOWN_TIME UNKNOWN_TIME <- list(first.time = NA_real_, last.time = NA_real_) info_msg <- "test.start_end_dates_do_not_exist" x <- "2014-02-30/2015-02-30" expect_warning(y <- .parseISO8601(x, START_N, END_N, "UTC"), pattern = "cannot determine first and last time") y <- suppressWarnings(.parseISO8601(x, START_N, END_N, "UTC")) expect_identical(y, UNKNOWN_TIME, info = info_msg) ### test.start_date_does_not_exist <- function() { ### DEACTIVATED("FAILS: returns everything") ### x <- "2015-02-30/2015-03-03" ### y <- .parseISO8601(x, START_N, END_N, "UTC") ### expect_identical(y, UNKNOWN_TIME, info = info_msg) ### } ### ### test.end_date_does_not_exist <- function() { ### DEACTIVATED("FAILS: returns everything") ### x <- "2015-02-25/2015-02-30" ### y <- .parseISO8601(x, START_N, END_N, "UTC") ### expect_identical(y, UNKNOWN_TIME, info = info_msg) ### } ### Fuzz tests info_msg <- "test.start_end_dates_are_garbage" x <- "0.21/8601.21" expect_warning(y <- .parseISO8601(x, START_N, END_N, "UTC"), pattern = "cannot determine first and last time") expect_identical(y, UNKNOWN_TIME, info = info_msg) info_msg <- "test.start_date_is_garbage" out <- list(first.time = START_T, last.time = as.POSIXct("2015-02-22", tz = "UTC") - 1e-5) x <- "garbage/2015-02-21" expect_warning(y <- .parseISO8601(x, START_N, END_N, "UTC"), pattern = "NAs introduced by coercion") expect_identical(y, out, info = info_msg) x <- "0.21/2015-02-21" y <- .parseISO8601(x, START_N, END_N, "UTC") expect_identical(y, out, info = info_msg) info_msg <- "test.end_date_is_garbage" out <- list(first.time = as.POSIXct("2015-02-25", tz = "UTC"), last.time = END_T) ### # ERRORS (uninformative) ### x <- "2015-02-25/garbage" ### y <- .parseISO8601(x, START_N, END_N, "UTC") ### expect_identical(y, UNKNOWN_TIME, info = info_msg) x <- "2015-02-25/8601.21" y <- .parseISO8601(x, START_N, END_N, "UTC") expect_identical(y, out, info = info_msg) info_msg <- "test.single_date_is_garbage" ### # ERRORS (uninformative) ### y <- .parseISO8601("garbage", START_N, END_N, "UTC") ### expect_identical(y, UNKNOWN_TIME, info = info_msg) expect_warning(y <- .parseISO8601("0.21", START_N, END_N, "UTC"), pattern = "cannot determine first and last time") expect_identical(y, UNKNOWN_TIME, info = info_msg) xts/inst/tinytest/test-subset-time-of-day.R0000644000176200001440000001015414522244665020461 0ustar liggesusers# Time-of-day subset tests info_msg <- "test.time_of_day_start_equals_end" i <- 0:47 x <- .xts(i, i * 3600, tzone = "UTC") i1 <- .index(x[c(2L, 26L)]) expect_identical(.index(x["T01:00/T01:00"]), i1, info = info_msg) info_msg <- "test.time_of_day_when_DST_starts" # 2017-03-12: no 0200 tz <- "America/Chicago" tmseq <- seq(as.POSIXct("2017-03-11", tz), as.POSIXct("2017-03-14", tz), by = "1 hour") x <- xts(seq_along(tmseq), tmseq) i <- structure(c(1489215600, 1489219200, 1489222800, 1489302000, 1489305600, 1489384800, 1489388400, 1489392000), tzone = "America/Chicago", tclass = c("POSIXct", "POSIXt")) expect_identical(.index(x["T01:00:00/T03:00:00"]), i, info = info_msg) info_msg <- "test.time_of_day_when_DST_ends" # 2017-11-05: 0200 occurs twice tz <- "America/Chicago" tmseq <- seq(as.POSIXct("2017-11-04", tz), as.POSIXct("2017-11-07", tz), by = "1 hour") x <- xts(seq_along(tmseq), tmseq) i <- structure(c(1509775200, 1509778800, 1509782400, 1509861600, 1509865200, 1509868800, 1509872400, 1509951600, 1509955200, 1509958800), tzone = "America/Chicago", tclass = c("POSIXct", "POSIXt")) expect_identical(.index(x["T01:00:00/T03:00:00"]), i, info = info_msg) info_msg <- "test.time_of_day_by_hour_start_equals_end" i <- 0:94 x <- .xts(i, i * 1800, tzone = "UTC") i1 <- .index(x[c(3, 4, 51, 52)]) expect_identical(.index(x["T01/T01"]), i1, info = info_msg) expect_identical(.index(x["T1/T1"]), i1, info = info_msg) info_msg <- "test.time_of_day_by_minute" i <- 0:189 x <- .xts(i, i * 900, tzone = "UTC") i1 <- .index(x[c(5:8, 101:104)]) expect_identical(.index(x["T01:00/T01:45"]), i1, info = info_msg) expect_identical(.index(x["T01/T01:45"]), i1, info = info_msg) info_msg <- "test.time_of_day_check_time_string" i <- 0:10 x <- .xts(i, i * 1800, tzone = "UTC") # Should work with and without colon separator expect_identical(x["T0100/T0115"], x["T01:00/T01:15"], info = info_msg) info_msg <- "test.time_of_day_by_second" i <- 0:500 x <- .xts(c(i, i), c(i * 15, 86400 + i * 15), tzone = "UTC") i1 <- .index(x[c(474L, 475L, 476L, 477L, 478L, 479L, 480L, 481L, 482L, 483L, 484L, 485L, 975L, 976L, 977L, 978L, 979L, 980L, 981L, 982L, 983L, 984L, 985L, 986L)]) expect_identical(.index(x["T01:58:05/T02:01:09"]), i1, info = info_msg) # Can only omit 0 padding for hours. Only for convenience because it does # not conform to the ISO 8601 standard, which requires padding with zeros. expect_identical(.index(x["T1:58:05/T2:01:09"]), i1, info = info_msg) expect_identical(.index(x["T1:58:05.000/T2:01:09.000"]), i1, info = info_msg) info_msg <- "test.time_of_day_end_before_start" # Yes, this actually makes sense and is useful for financial markets # E.g. some futures markets open at 18:00 and close at 16:00 the next day i <- 0:47 x <- .xts(i, i * 3600, tzone = "UTC") i1 <- .index(x[-c(18L, 42L)]) expect_identical(.index(x["T18:00/T16:00"]), i1, info = info_msg) # TODO: Add tests for possible edge cases and/or errors # end time before start time # start time and/or end time missing "T" prefix info_msg <- "test.time_of_day_on_zero_width" # return relevant times and a column of NA; consistent with zoo i <- 0:47 tz <- "America/Chicago" x <- .xts(, i * 3600, tzone = tz) y <- x["T18:00/T20:00"] expect_identical(y, .xts(rep(NA, 6), c(0:2, 24:26)*3600, tzone = tz), info = info_msg) info_msg <- "test.time_of_day_zero_padding" i <- 0:189 x <- .xts(i, i * 900, tzone = "UTC") i1 <- .index(x[c(5:8, 101:104)]) expect_identical(.index(x["T01:00/T01:45"]), i1, info = info_msg) # we support un-padded hours, for convenience (it's not in the standard) expect_identical(.index(x["T1/T1:45"]), i1, info = info_msg) # minutes and seconds must be zero-padded expect_error(x["T01:5:5/T01:45"], info = info_msg) expect_error(x["T01:05:5/T01:45"], info = info_msg) info_msg <- "test.open_ended_time_of_day" ix <- seq(.POSIXct(0), .POSIXct(86400 * 5), by = "sec") ix <- ix + runif(length(ix)) x <- xts::xts(seq_along(ix), ix) expect_true(all(xts::.indexhour(x["T1800/"]) > 17), info = paste(info_msg, "right open")) expect_true(all(xts::.indexhour(x["/T0500"]) < 6), info = paste(info_msg, "left open")) xts/inst/tinytest/test-coredata.R0000644000176200001440000000350614522244665016630 0ustar liggesusersinfo_msg <- "test.coredata_vector" x <- xts(1, as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(target = coredata(z), current = coredata(x), info = info_msg) info_msg <- "test.coredata_named_vector" x <- xts(c(hello = 1), as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) info_msg <- "test.coredata_matrix" x <- xts(cbind(1, 9), as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) info_msg <- "test.coredata_named_matrix" x <- xts(cbind(hello = 1, world = 9), as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) info_msg <- "test.coredata_data.frame" x <- xts(data.frame(hello = 1, world = 9), as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) info_msg <- "test.coredata_ts" x <- xts(ts(1), as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) # empty objects info_msg <- "test.coredata_empty" x <- xts(, as.Date("2018-03-02")) z <- as.zoo(x) expect_identical(coredata(z), coredata(x), info = info_msg) info_msg <- "test.coredata_empty_dim" x <- xts(cbind(1, 9), as.Date("2018-03-02")) z <- as.zoo(x) x0 <- x[0,] z0 <- z[0,] expect_identical(coredata(z0), coredata(x0), info = info_msg) info_msg <- "test.coredata_empty_dim_dimnames" x <- xts(cbind(hello = 1, world = 9), as.Date("2018-03-02")) z <- as.zoo(x) x0 <- x[0,] z0 <- z[0,] expect_identical(coredata(z0), coredata(x0), info = info_msg) xts/inst/tinytest/test-index.R0000644000176200001440000000323114522244665016150 0ustar liggesusersinfo_msg <- "test.get_index_does_not_error_if_index_has_no_attributes" x <- .xts(1:3, 1:3, tzone = "UTC") ix <- index(x) ix <- ix + 3 attr(x, "index") <- 4:6 # get index (test will fail if it errors) expect_warning(index(x), info = info_msg) info_msg <- "test.set_.index_copies_index_attributes" x <- .xts(1:3, 1:3, tzone = "UTC") ix <- index(x) ix <- ix + 3 .index(x) <- 4:6 expect_equal(index(x), ix, info = info_msg) info_msg <- "test.set_index_copies_index_attributes" x <- .xts(1:3, 1:3, tzone = "UTC") ix <- index(x) ix <- ix + 3 index(x) <- .POSIXct(4:6, "UTC") expect_equal(index(x), ix, info = info_msg) # x index must be numeric, because index<-.xts coerces RHS to numeric info_msg <- "test.set_index_restores_tzone_attribute" x <- .xts(1:3, 1:3+0, tzone = "") y <- x # Ops.POSIXt drops tzone attribute when tzone = "" index(y) <- index(y) + 0 expect_identical(x, y, info = info_msg) info_msg <- "test.get_index_zero_length_Date_returns_correct_index_type" xd <- xts(1, .Date(1)) zd <- as.zoo(xd) xd_index <- index(xd[0,]) expect_true(length(xd_index) == 0, info = paste(info_msg, "- length(index) == 0")) expect_equal(index(xd[0,]), index(zd[0,]), info = info_msg) expect_equal(index(xd[0,]), .Date(numeric()), info = info_msg) info_msg <- "test.get_index_zero_length_POSIXct_returns_correct_index_type" xp <- xts(1, .POSIXct(1), tzone = "UTC") zp <- as.zoo(xp) xp_index <- index(xp[0,]) zp_index <- index(zp[0,]) zl_index <- .POSIXct(numeric(), tz = "UTC") expect_true(length(xp_index) == 0, info = paste(info_msg, "- length(index) == 0")) expect_equal(tzone(xp_index), tzone(zp_index), info = info_msg) expect_inherits(xp_index, c("POSIXct", "POSIXt"), info = info_msg) xts/inst/tinytest/test-ts.R0000644000176200001440000000635014522244665015474 0ustar liggesusersdata(sample_matrix) sample.ts1 <- ts(sample_matrix,start=as.numeric(as.Date(rownames(sample_matrix)[1]))) sample.xts.ts1 <- as.xts(sample.ts1) info_msg <- "test.convert_ts_to_xts" expect_identical(sample.xts.ts1, as.xts(sample.ts1), info = info_msg) info_msg <- "test.convert_ts_to_xts_j1" expect_identical(sample.xts.ts1[,1], as.xts(sample.ts1)[,1], info = info_msg) info_msg <- "test.convert_ts_to_xts_i1" expect_identical(sample.xts.ts1[1,], as.xts(sample.ts1)[1,], info = info_msg) info_msg <- "test.convert_ts_to_xts_i1j1" expect_identical(sample.xts.ts1[1,1], as.xts(sample.ts1)[1,1], info = info_msg) info_msg <- "test.ts_reclass" expect_identical(sample.ts1, reclass(try.xts(sample.ts1)), info = info_msg) info_msg <- "test.ts_reclass_subset_reclass_j1" expect_identical(sample.ts1[,1], reclass(try.xts(sample.ts1))[,1], info = info_msg) info_msg <- "test.ts_reclass_subset_as.xts_j1" expect_identical(sample.ts1[,1], reclass(try.xts(sample.ts1)[,1]), info = info_msg) info_msg <- "test.ts_reclass_subset_ts_j1" expect_identical(sample.ts1[,1], reclass(try.xts(sample.ts1[,1])), info = info_msg) # quarterly series sample.ts4 <- ts(sample_matrix,start=1960,frequency=4) sample.xts.ts4 <- as.xts(sample.ts4) info_msg <- "test.convert_ts4_to_xts" expect_identical(sample.xts.ts4, as.xts(sample.ts4), info = info_msg) info_msg <- "test.convert_ts4_to_xts_j1" expect_identical(sample.xts.ts4[,1], as.xts(sample.ts4)[,1], info = info_msg) info_msg <- "test.convert_ts4_to_xts_i1" expect_identical(sample.xts.ts4[1,], as.xts(sample.ts4)[1,], info = info_msg) info_msg <- "test.convert_ts4_to_xts_i1j1" expect_identical(sample.xts.ts4[1,1], as.xts(sample.ts4)[1,1], info = info_msg) info_msg <- "test.ts4_reclass" expect_identical(sample.ts4, reclass(try.xts(sample.ts4)), info = info_msg) info_msg <- "test.ts4_reclass_subset_reclass_j1" expect_identical(sample.ts4[,1], reclass(try.xts(sample.ts4))[,1], info = info_msg) info_msg <- "test.ts4_reclass_subset_as.xts_j1" expect_identical(sample.ts4[,1], reclass(try.xts(sample.ts4)[,1]), info = info_msg) info_msg <- "test.ts4_reclass_subset_ts_j1" expect_identical(sample.ts4[,1], reclass(try.xts(sample.ts4[,1])), info = info_msg) # monthly series sample.ts12 <- ts(sample_matrix,start=1990,frequency=12) sample.xts.ts12 <- as.xts(sample.ts12) info_msg <- "test.convert_ts12_to_xts" expect_identical(sample.xts.ts12, as.xts(sample.ts12), info = info_msg) info_msg <- "test.convert_ts12_to_xts_j1" expect_identical(sample.xts.ts12[,1], as.xts(sample.ts12)[,1], info = info_msg) info_msg <- "test.convert_ts12_to_xts_i1" expect_identical(sample.xts.ts12[1,], as.xts(sample.ts12)[1,], info = info_msg) info_msg <- "test.convert_ts12_to_xts_i1j1" expect_identical(sample.xts.ts12[1,1], as.xts(sample.ts12)[1,1], info = info_msg) info_msg <- "test.ts12_reclass" expect_identical(sample.ts12, reclass(try.xts(sample.ts12)), info = info_msg) info_msg <- "test.ts12_reclass_subset_reclass_j1" expect_identical(sample.ts12[,1], reclass(try.xts(sample.ts12))[,1], info = info_msg) info_msg <- "test.ts12_reclass_subset_as.xts_j1" expect_identical(sample.ts12[,1], reclass(try.xts(sample.ts12)[,1]), info = info_msg) info_msg <- "test.ts12_reclass_subset_ts_j1" expect_identical(sample.ts12[,1], reclass(try.xts(sample.ts12[,1])), info = info_msg) xts/inst/tinytest/test-split.R0000644000176200001440000000504214522244665016176 0ustar liggesusersnm_minutes <- c("1970-01-01 00:00:00", "1970-01-01 00:01:00") # 'f' is character, but length(f) > 1 info_msg <- "test.split_character_f_not_endpoints" x <- .xts(1:5, 1:5) f <- letters[1:nrow(x)] expect_identical(split(x,f), split(as.zoo(x),f), info = info_msg) info_msg <- "test.split_returns_named_list" qtr_2020 <- paste0("2020 Q", 1:4) qtr_2021 <- paste0("2021 Q", 1:4) info_msg <- "quarterly data split by year" x_q <- xts(1:8, as.yearqtr(c(qtr_2020, qtr_2021))) nm_q <- names(split(x_q, "years")) expect_identical(c("2020", "2021"), nm_q, info = info_msg) # names formatted as yearqtr info_msg <- "monthly data split by quarter" x_mo <- xts(1:12, as.yearmon(2020 + 0:11/12)) nm_mo <- names(split(x_mo, "quarters")) expect_identical(qtr_2020, nm_mo, info = info_msg) # names formatted as yearmon info_msg <- "daily data split by month" x_day <- xts(1:10, .Date(-5:4)) nm_day <- names(split(x_day, "months")) expect_identical(c("Dec 1969", "Jan 1970"), nm_day, info = info_msg) # names formatted as Date info_msg <- "hourly data split by day" x_hr <- .xts(1:10, -5:4 * 3600, tzone = "UTC") nm_hr <- names(split(x_hr, "days")) expect_identical(c("1969-12-31", "1970-01-01"), nm_hr, info = info_msg) info_msg <- "second data split by minute" x_sec <- .xts(1:120, 1:120 - 1, tzone = "UTC") nm_sec <- names(split(x_sec, "minutes")) expect_identical(nm_minutes, nm_sec, info = info_msg) if (.Machine$sizeof.pointer == 8) { # only run on 64-bit systems because this fails on 32-bit systems due to # precision issues # # ?.Machine says: # sizeof.pointer: the number of bytes in a C 'SEXP' type. Will be '4' on # 32-bit builds and '8' on 64-bit builds of R. info_msg <- "microsecond data split by milliseconds" t1 <- as.POSIXct(nm_minutes[1], tz = "UTC") us <- seq(1e-4, 2e-1, 1e-4) x_us <- xts(seq_along(us), t1 + us) nm_ms <- names(split(x_us, "milliseconds")) nm_target <- format(t1 + seq(0, 0.2, 0.001), "%Y-%m-%d %H:%M:%OS3") expect_identical(nm_target, nm_ms, info = info_msg) } # names correct when object TZ vs GMT are on different sides of split breaks (#392) info_msg <- "yearmon: object TZ and GMT are different days" x_tz <- .xts(1:3, c(1632481200, 1633042800, 1635724800), tzone = "Europe/Berlin") expect_identical(names(split(x_tz, "months")), paste(c("Sep", "Oct", "Nov"), "2021"), info = info_msg) info_msg <- "yearqtr: object TZ and GMT are different days" expect_identical(names(split(x_tz, "quarters")), c("2021 Q3", "2021 Q4"), info = info_msg) xts/inst/tinytest/test-dimnames.R0000644000176200001440000000200514522244665016634 0ustar liggesusers### colnames(x) are not removed when 'x' and 'y' are shared and dimnames(y) <- NULL orig_names <- c("a", "b") x <- .xts(cbind(1:2, 1:2), 1:2, dimnames = list(NULL, orig_names)) y <- x dimnames(y) <- NULL expect_null(colnames(y), info = "dimnames(y) <- NULL removes dimnames from y") expect_identical(orig_names, colnames(x), info = "dimnames(y) <- NULL does not remove dimnames from x") ### colnames(x) are not changed when 'x' and 'y' are shared and dimnames(y) <- foo new_names <- c("c", "d") x <- .xts(cbind(1:2, 1:2), 1:2, dimnames = list(NULL, orig_names)) y <- x dimnames(y) <- list(NULL, new_names) expect_identical(new_names, colnames(y), info = "dimnames(y) <- list(NULL, new_names) set correctly on y") expect_identical(orig_names, colnames(x), info = "dimnames(y) <- list(NULL, new_names) does not change dimnames on x") new_names[1] <- "e" expect_identical(c("c", "d"), colnames(y), info = "colnames(y) not changed when new_names is changed") xts/inst/tinytest/test-all.equal.R0000644000176200001440000000133514522244665016722 0ustar liggesusers# ensure xts objects with index attributes attached are equal to # xts objects with index attributes on the index only info_msg <- "test.attr_on_object_equal_to_attr_on_index" attrOnObj <- structure(1:3, index = structure(1:3, tzone = "UTC", tclass = "Date"), class = c("xts", "zoo"), dim = c(3L, 1L), .indexCLASS = "Date", .indexTZ = "UTC", tclass = "Date", tzone = "UTC", dimnames = list(NULL, "x")) attrOnIndex <- structure(1:3, index = structure(1:3, tzone = "UTC", tclass = "Date"), class = c("xts", "zoo"), dim = c(3L, 1L), dimnames = list(NULL, "x")) expect_equal(target = attrOnIndex, current = attrOnObj, info = info_msg) xts/inst/tinytest/test-Ops.R0000644000176200001440000004116314522244665015610 0ustar liggesusersall.modes <- c("double", "integer", "logical", "character") ops.math <- c("+", "-", "*", "/", "^", "%%", "%/%") ops.relation <- c(">", ">=", "==", "!=", "<=", "<") ops.logic <- c("&", "|", ops.relation) all.ops <- c(ops.math, ops.logic) ops_numeric_tester <- function(e1, e2, mode, op) { storage.mode(e1) <- mode storage.mode(e2) <- mode eval(call(op, e1, e2)) } make_msg <- function(info, op, type) { sprintf("%s op: %s, type: %s", info, op, type) } ### {{{ 2-column objects info_msg <- "test.ops_xts2d_matrix2d_dimnames" X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y"))) M1 <- as.matrix(X1) * 5 M2 <- M1 colnames(M2) <- rev(colnames(M2)) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(M2, X1, m, o) E <- X1 colnames(E) <- colnames(M2) E[] <- ops_numeric_tester(M2, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts2d_matrix2d_only_colnames" X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y"))) M1 <- coredata(X1) * 5 M2 <- M1 colnames(M2) <- rev(colnames(M2)) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(M2, X1, m, o) E <- X1 colnames(E) <- colnames(M2) E[] <- ops_numeric_tester(M2, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts2d_matrix2d_only_rownames" X1 <- .xts(cbind(1:3, 4:6), 1:3) M1 <- coredata(X1) * 5 rownames(M1) <- format(.POSIXct(1:3)) M2 <- M1 colnames(M2) <- rev(colnames(M2)) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(M2, X1, m, o) E <- X1 colnames(E) <- colnames(M2) E[] <- ops_numeric_tester(M2, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts2d_matrix2d_no_dimnames" X1 <- .xts(cbind(1:3, 1:3), 1:3) M1 <- coredata(X1) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(M1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(M1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } ### }}} 2-column objects ### {{{ 1-column objects info_msg <- "test.ops_xts1d_matrix1d_dimnames" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) M1 <- as.matrix(X1) * 5 M2 <- M1 colnames(M2) <- "y" for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(M2, X1, m, o) E <- X1 E[] <- ops_numeric_tester(M2, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" colnames(E) <- "y" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_matrix1d_only_colnames" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) M1 <- coredata(X1) * 5 M2 <- M1 colnames(M2) <- "y" for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(M2, X1, m, o) E <- X1 E[] <- ops_numeric_tester(M2, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" colnames(E) <- "y" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_matrix1d_only_rownames" X1 <- .xts(1:3, 1:3) M1 <- coredata(X1) * 5 rownames(M1) <- format(.POSIXct(1:3)) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(M1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(M1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_matrix1d_no_dimnames" X1 <- .xts(1:3, 1:3) M1 <- coredata(X1) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(M1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(M1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_xts1d" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(X1), coredata(X1), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_xts1d_different_index" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) X2 <- .xts(2:4, 2:4, dimnames = list(NULL, "y")) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, X2, m, o) E <- X1[2:3,] E[] <- ops_numeric_tester(coredata(E), coredata(X2[1:2,]), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments should only change column names e <- ops_numeric_tester(X2, X1, m, o) E <- X2[1:2,] E[] <- ops_numeric_tester(coredata(X1[2:3,]), coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } ### }}} 1-column objects ### {{{ xts with dim, vector info_msg <- "test.ops_xts2d_vector_no_names" X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y"))) V1 <- as.vector(coredata(X1[,1L])) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, V1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), V1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(V1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(V1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts2d_vector_names" X1 <- .xts(cbind(1:3, 4:6), 1:3, dimnames = list(NULL, c("x", "y"))) V1 <- setNames(as.vector(X1[,1L]), index(X1)) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, V1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), V1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(V1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(V1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_vector_no_names" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) V1 <- as.vector(coredata(X1[,1L])) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, V1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), V1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(V1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(V1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts1d_vector_names" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) V1 <- setNames(as.vector(X1[,1L]), index(X1)) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(X1, V1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(E), V1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(V1, X1, m, o) E <- X1 E[] <- ops_numeric_tester(V1, coredata(E), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } ### }}} xts with dim, vector ### {{{ xts no dims, matrix/vector info_msg <- "test.ops_xts_no_dim_matrix1d" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) Xv <- drop(X1) M1 <- coredata(X1) * 5 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(Xv, M1, m, o) E <- X1 E[] <- ops_numeric_tester(coredata(Xv), M1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(M1, Xv, m, o) E <- X1 E[] <- ops_numeric_tester(M1, coredata(Xv), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts_no_dim_matrix2d" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) Xv <- drop(X1) X2 <- merge(x = Xv * 2, y = Xv * 5) M2 <- coredata(X2) for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(Xv, M2, m, o) E <- X2 E[] <- ops_numeric_tester(coredata(Xv), M2, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" # results no identical because attributes change order expect_equal(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(M2, Xv, m, o) E <- X2 E[] <- ops_numeric_tester(M2, coredata(Xv), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" # results no identical because attributes change order expect_equal(e, E, info = make_msg(info_msg, o, m)) } } info_msg <- "test.ops_xts_no_dim_vector" X1 <- .xts(1:3, 1:3, dimnames = list(NULL, "x")) Xv <- drop(X1) V1 <- 4:6 for (o in all.ops) { for (m in all.modes) { if ("character" == m && !(o %in% ops.relation)) next e <- ops_numeric_tester(Xv, V1, m, o) E <- Xv E[] <- ops_numeric_tester(coredata(Xv), V1, m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) # order of arguments shouldn't matter e <- ops_numeric_tester(V1, Xv, m, o) E <- Xv E[] <- ops_numeric_tester(V1, coredata(Xv), m, o) if (o %in% ops.logic) storage.mode(E) <- "logical" expect_identical(e, E, info = make_msg(info_msg, o, m)) } } ### }}} xts vector, matrix/vector ### These tests check that the time class of a time series on which ### a relational operator is applied is not changed. ts1 <- xts(17, order.by = as.Date('2020-01-29')) info_msg <- "test.get_tclass_ts1" expect_identical(tclass(ts1), c("Date"), info = info_msg) info_msg <- "test.tclass_after_rel_op" expect_identical(tclass(ts1 < 0), c("Date"), info = paste(info_msg, "| <")) expect_identical(tclass(ts1 > 0), c("Date"), info = paste(info_msg, "| >")) expect_identical(tclass(ts1 <= 0), c("Date"), info = paste(info_msg, "| <=")) expect_identical(tclass(ts1 >= 0), c("Date"), info = paste(info_msg, "| >=")) expect_identical(tclass(ts1 == 0), c("Date"), info = paste(info_msg, "| ==")) expect_identical(tclass(ts1 != 0), c("Date"), info = paste(info_msg, "| !=")) tstz <- "Atlantic/Reykjavik" ts2 <- xts(17, order.by = as.POSIXct("2020-01-29", tz = tstz)) info_msg <- "test.get_tclass_POSIXct_ts2" expect_true("POSIXct" %in% tclass(ts2), info = info_msg) info_msg <- "test.tclass_POSIXct_after_rel_op" expect_true("POSIXct" %in% tclass(ts2 < 0), info = paste(info_msg, "| <")) expect_true("POSIXct" %in% tclass(ts2 > 0), info = paste(info_msg, "| >")) expect_true("POSIXct" %in% tclass(ts2 <= 0), info = paste(info_msg, "| <=")) expect_true("POSIXct" %in% tclass(ts2 >= 0), info = paste(info_msg, "| >=")) expect_true("POSIXct" %in% tclass(ts2 == 0), info = paste(info_msg, "| ==")) expect_true("POSIXct" %in% tclass(ts2 != 0), info = paste(info_msg, "| !=")) info_msg <- "test.get_tzone_ts2" expect_identical(tzone(ts2), tstz, info = info_msg) info_msg <- "test.tzone_after_rel_op" expect_identical(tzone(ts2 < 0), tstz, info = paste(info_msg, "| <")) expect_identical(tzone(ts2 > 0), tstz, info = paste(info_msg, "| >")) expect_identical(tzone(ts2 <= 0), tstz, info = paste(info_msg, "| <=")) expect_identical(tzone(ts2 >= 0), tstz, info = paste(info_msg, "| >=")) expect_identical(tzone(ts2 == 0), tstz, info = paste(info_msg, "| ==")) expect_identical(tzone(ts2 != 0), tstz, info = paste(info_msg, "| !=")) ### Ops.xts() doesn't change column names x <- .xts(1:3, 1:3, dimnames = list(NULL, c("-1"))) z <- as.zoo(x) expect_equal(names(x + x[-1,]), names(z + z[-1,]), "Ops.xts() doesn't change column names when merge() is called") expect_equal(names(x + x), names(z + z), "Ops.xts() doesn't change column names when indexes are equal") ### Ops.xts returns derived class st <- Sys.time() x1 <- xts(1, st) x2 <- xts(2, st) x3 <- xts(3, st) # regular xts object # derived class objects klass <- c("foo", "xts", "zoo") class(x1) <- klass class(x2) <- klass expect_identical(klass, class(x1 + x2), "Ops.xts('foo', 'foo') returns derived class") expect_identical(klass, class(x2 + x1), "Ops.xts('foo', 'foo') returns derived class") expect_identical(klass, class(x1 + x3), "Ops.xts('foo', 'xts') returns derived class") expect_identical(class(x3), class(x3 + x1), "Ops.xts('xts', 'foo') returns xts class") info_msg <- "test.Ops.xts_unary" xpos <- xts(1, .Date(1)) xneg <- xts(-1, .Date(1)) lt <- xts(TRUE, .Date(1)) lf <- xts(FALSE, .Date(1)) expect_identical(xpos, +xpos, info = paste(info_msg, "+ positive xts")) expect_identical(xneg, +xneg, info = paste(info_msg, "+ negative xts")) expect_identical(xneg, -xpos, info = paste(info_msg, "- positive xts")) expect_identical(xpos, -xneg, info = paste(info_msg, "- negative xts")) expect_identical(lf, !lt, info = paste(info_msg, "! TRUE")) expect_identical(lt, !lf, info = paste(info_msg, "! FALSE")) xts/inst/tinytest/test-matrix.R0000644000176200001440000000377514522244665016362 0ustar liggesusersdata(sample_matrix) sample.matrix <- sample_matrix sample.xts <- as.xts(sample.matrix) info_msg <- "test.convert_matrix_to_xts" expect_identical(sample.xts, as.xts(sample.matrix), info = info_msg) info_msg <- "test.convert_matrix_to_xts_j1" expect_identical(sample.xts[, 1], as.xts(sample.matrix)[, 1], info = info_msg) info_msg <- "test.convert_matrix_to_xts_i1" expect_identical(sample.xts[1,], as.xts(sample.matrix)[1,], info = info_msg) info_msg <- "test.convert_matrix_to_xts_i1j1" expect_identical(sample.xts[1, 1], as.xts(sample.matrix)[1, 1], info = info_msg) info_msg <- "test.matrix_reclass" expect_identical(sample.matrix, reclass(try.xts(sample.matrix)), info = info_msg) info_msg <- "test.matrix_reclass_subset_reclass_j1" expect_identical(sample.matrix[, 1], reclass(try.xts(sample.matrix))[, 1], info = info_msg) info_msg <- "test.matrix_reclass_subset_as.xts_j1" expect_identical(sample.matrix[, 1, drop = FALSE], reclass(try.xts(sample.matrix)[, 1]), info = info_msg) expect_identical(sample.matrix[, 1], reclass(try.xts(sample.matrix))[, 1], info = info_msg) info_msg <- "test.matrix_reclass_subset_matrix_j1" expect_identical(sample.matrix[, 1, drop = FALSE], reclass(try.xts(sample.matrix[, 1, drop = FALSE])), info = info_msg) ### zero-width to matrix info_msg <- "test.zero_width_xts_to_matrix" x <- .xts(,1) xm <- as.matrix(x) zm <- as.matrix(as.zoo(x)) expect_identical(xm, zm, info = info_msg) ### dim-less xts to matrix info_msg <- "test.dimless_xts_to_matrix" ix <- structure(1:3, tclass = c("POSIXct", "POSIXt"), tzone = "") x <- structure(1:3, index = ix, class = c("xts", "zoo")) m <- matrix(1:3, 3, 1, dimnames = list(format(.POSIXct(1:3)), "x")) expect_identical(as.matrix(x), m, info = info_msg) xts/inst/tinytest/test-merge.R0000644000176200001440000002572314522244665016152 0ustar liggesuserszero_width_xts <- xts() info_msg <- "test.merge_empty_xts_with_2_scalars" m1 <- merge(zero_width_xts, 1, 1) m2 <- merge(merge(zero_width_xts, 1), 1) expect_identical(m1, zero_width_xts) expect_identical(m2, zero_width_xts) info_msg <- "test.merge_more_than_2_zero_width_objects" m1 <- merge(zero_width_xts, zero_width_xts, zero_width_xts) expect_identical(m1, zero_width_xts) ### Tests for NA in index. Construct xts object using structure() because ### xts constructors should not allow users to create objects with NA in ### the index indexHasNA_dbl <- structure(1:5, .Dim = c(5L, 1L), index = structure(c(1, 2, 3, 4, NA), tzone = "", tclass = c("POSIXct", "POSIXt")), .indexCLASS = c("POSIXct", "POSIXt"), .indexTZ = "", tclass = c("POSIXct", "POSIXt"), tzone = "", class = c("xts", "zoo")) indexHasNA_int <- structure(1:5, .Dim = c(5L, 1L), index = structure(c(1L, 2L, 3L, 4L, NA), tzone = "", tclass = c("POSIXct", "POSIXt")), .indexCLASS = c("POSIXct", "POSIXt"), .indexTZ = "", tclass = c("POSIXct", "POSIXt"), tzone = "", class = c("xts", "zoo")) info_msg <- "test.merge_index_contains_NA_integer" expect_error(merge(indexHasNA_int, indexHasNA_int), info = info_msg) info_msg <- "test.merge_index_contains_NA_double" expect_error(merge(indexHasNA_dbl, indexHasNA_dbl), info = info_msg) info_msg <- "test.merge_index_contains_NaN" x <- indexHasNA_dbl idx <- attr(x, "index") idx[length(idx)] <- NaN attr(x, "index") <- idx expect_error(merge(x, x), info = info_msg) info_msg <- "test.merge_index_contains_Inf" x <- indexHasNA_dbl idx <- attr(x, "index") idx[length(idx)] <- Inf attr(x, "index") <- idx expect_error(merge(x, x), info = info_msg) idx <- rev(idx) idx[1L] <- -Inf attr(x, "index") <- idx expect_error(merge(x, x), info = info_msg) ### /end Tests for NA in index ### zero-length fill argument info_msg <- "test.merge_fill_NULL" x1 <- .xts(1, 1) x2 <- .xts(2, 2) x <- merge(x1, x2, fill = NULL) out <- .xts(matrix(c(1, NA, NA, 2), 2), c(1,2)) colnames(out) <- c("x1", "x2") expect_identical(x, out, info = info_msg) info_msg <- "test.merge_fill_zero_length" x1 <- .xts(1, 1) x2 <- .xts(2, 2) x <- merge(x1, x2, fill = numeric()) out <- .xts(matrix(c(1, NA, NA, 2), 2), c(1,2)) colnames(out) <- c("x1", "x2") expect_identical(x, out, info = info_msg) info_msg <- "test.merge_with_zero_width_returns_original_type" M1 <- .xts(1:3, 1:3, dimnames = list(NULL, "m1")) types <- c("double", "integer", "logical", "character") for (type in types) { m1 <- M1 storage.mode(m1) <- type e1 <- .xts(,1:3) m2 <- merge(m1, e1) expect_identical(m1, m2, info = paste(info_msg, "- type =", type)) } info_msg <- "test.n_way_merge_on_all_types" D1 <- as.Date("2018-01-03")-2:0 M1 <- xts(1:3, D1, dimnames = list(NULL, "m")) M3 <- xts(cbind(1:3, 1:3, 1:3), D1, dimnames = list(NULL, c("m", "m.1", "m.2"))) types <- c("double", "integer", "logical", "character", "complex") for (type in types) { m1 <- M1 m3 <- M3 storage.mode(m1) <- storage.mode(m3) <- type m <- merge(m1, m1, m1) expect_identical(m, m3, info = paste(info_msg, "- type =", type)) } info_msg <- "test.shorter_colnames_for_unnamed_args" X <- .xts(rnorm(10, 10), 1:10) types <- c("double", "integer", "logical", "character", "complex") for (type in types) { x <- X storage.mode(x) <- type mx <- do.call(merge, list(x, x)) expect_true(all(nchar(colnames(mx)) < 200), info = paste(info_msg, "- type = ", type)) } info_msg <- "test.check_names_false" x <- .xts(1:3, 1:3, dimnames = list(NULL, "42")) y <- .xts(1:3, 1:3, dimnames = list(NULL, "21")) z <- merge(x, y) # leading "X" added expect_identical(colnames(z), c("X42", "X21"), info = info_msg) z <- merge(x, y, check.names = TRUE) # same expect_identical(colnames(z), c("X42", "X21"), info = info_msg) z <- merge(x, y, check.names = FALSE) # should have numeric column names expect_identical(colnames(z), c("42", "21"), info = info_msg) info_msg <- "test.merge_fills_complex_types" data. <- cbind(c(1:5*1i, NA, NA), c(NA, NA, 3:7*1i)) colnames(data.) <- c("x", "y") d21 <- data. d21[is.na(d21)] <- 21i x <- xts(1:5 * 1i, as.Date(1:5, origin = "1970-01-01")) y <- xts(3:7 * 1i, as.Date(3:7, origin = "1970-01-01")) z <- merge(x, y) expect_equivalent(coredata(z), data., info = paste(info_msg, "- default fill")) z <- merge(x, y, fill = 21i) expect_equivalent(coredata(z), d21, info = paste(info_msg, "- fill = 21i")) .index(x) <- as.integer(.index(x)) .index(y) <- as.integer(.index(y)) z <- merge(x, y) expect_equivalent(coredata(z), data., info = paste(info_msg, "- default fill, integer index")) z <- merge(x, y, fill = 21i) expect_equivalent(coredata(z), d21, info = paste(info_msg, "- fill = 21i, integer index")) info_msg <- "test.suffixes_appended" x <- xts(data.frame(x = 1), as.Date("2012-01-01")) y <- xts(data.frame(x = 2), as.Date("2012-01-01")) suffixes <- c("truex", "truey") out <- merge(x, y, suffixes = suffixes) expect_equal(paste0("x", suffixes), colnames(out), info = info_msg) info_msg <- "test.suffix_append_order" idx <- Sys.Date() - 1:10 x1 <- xts(cbind(alpha = 1:10, beta = 2:11), idx) x2 <- xts(cbind(alpha = 3:12, beta = 4:13), idx) x3 <- xts(cbind(alpha = 5:14, beta = 6:15), idx) suffixes <- LETTERS[1:3] mx <- merge(x1, x2, x3, suffixes = paste0('.', suffixes)) mz <- merge.zoo(x1, x2, x3, suffixes = suffixes) expect_equal(mx, as.xts(mz), info = info_msg) ### merging zero-width objects z1 <- structure(numeric(0), index = structure(1:10, class = "Date"), class = "zoo") x1 <- as.xts(z1) z2 <- structure(numeric(0), index = structure(5:14, class = "Date"), class = "zoo") x2 <- as.xts(z2) info_msg <- "merge.xts() on zero-width objects and all = TRUE matches merge.zoo()" z3 <- merge(z1, z2, all = TRUE) x3 <- merge(x1, x2, all = TRUE) # use expect_equivalent because xts index has tclass and tzone and zoo doesn't expect_equivalent(index(z3), index(x3), info = info_msg) info_msg <- "merge.xts() zero-width objects and all = FALSE matches merge.zoo()" z4 <- merge(z1, z2, all = FALSE) x4 <- merge(x1, x2, all = FALSE) # use expect_equivalent because xts index has tclass and tzone and zoo doesn't expect_equivalent(index(z4), index(x4), info = info_msg) info_msg <- "merge.xts() on zero-width objects and all = c(TRUE, FALSE) matches merge.zoo()" z5 <- merge(z1, z2, all = c(TRUE, FALSE)) x5 <- merge(x1, x2, all = c(TRUE, FALSE)) # use expect_equivalent because xts index has tclass and tzone and zoo doesn't expect_equivalent(index(z5), index(x5), info = info_msg) info_msg <- "merge.xts() on zero-width objects and all = c(FALSE, TRUE) matches merge.zoo()" z6 <- merge(z1, z2, all = c(FALSE, TRUE)) x6 <- merge(x1, x2, all = c(FALSE, TRUE)) # use expect_equivalent because xts index has tclass and tzone and zoo doesn't expect_equivalent(index(z6), index(x6), info = info_msg) ### merge.xts() matches merge.zoo() for various calls on zero-length objects with column names x <- xts(matrix(1:9, 3, 3), .Date(17167:17169), dimnames = list(NULL, c("a","b","c"))) z <- as.zoo(x) x0 <- xts(coredata(x), index(x)+5)[FALSE] z0 <- zoo(coredata(z), index(z)+5)[FALSE] xm1 <- merge(x, x0, all = c(TRUE, FALSE)) zm1 <- merge(z, z0, all = c(TRUE, FALSE)) expect_equivalent(coredata(xm1), coredata(zm1), info = "merge.xts(x, empty_named, all = c(TRUE, FALSE)) coredata matches merge.zoo()") expect_equivalent(index(xm1), index(zm1), info = "merge.xts(x, empty_named, all = c(TRUE, FALSE)) index matches merge.zoo()") xm2 <- merge(x0, x, all = c(FALSE, TRUE)) zm2 <- merge(z0, z, all = c(FALSE, TRUE)) expect_equivalent(coredata(xm2), coredata(zm2), info = "merge.xts(empty_named, x, all = c(FALSE, TRUE)) coredata matches merge.zoo()") expect_equivalent(index(xm2), index(zm2), info = "merge.xts(empty_named, x, all = c(FALSE, TRUE)) index matches merge.zoo()") xm3 <- merge(x, x0) zm3 <- merge(z, z0) expect_equivalent(coredata(xm3), coredata(zm3), info = "merge.xts(x, empty_named) coredata matches merge.zoo()") expect_equivalent(index(xm3), index(zm3), info = "merge.xts(x, empty_named) index matches merge.zoo()") xm4 <- merge(x0, x) zm4 <- merge(z0, z) expect_equivalent(coredata(xm4), coredata(zm4), info = "merge.xts(empty_named, x) coredata matches merge.zoo()") expect_equivalent(index(xm4), index(zm4), info = "merge.xts(empty_named, x) index matches merge.zoo()") # merge.zoo() returns an empty object in these cases, so we can't expect merge.xts() to match merge.zoo() #xm5 <- merge(x0, x0) #zm5 <- merge(z0, z0) #expect_equivalent(xm5, zm5, info = "merge.xts([empty_named 2x]) matches merge.zoo()") #xm6 <- merge(x0, x0, x0) #zm6 <- merge(z0, z0, z0) #expect_equivalent(xm6, zm6, info = "merge.xts([empty_named 3x]) matches merge.zoo()") xm5 <- merge(x0, x0) empty_with_dims_2x <- structure(integer(0), dim = c(0L, 6L), index = .index(x0), dimnames = list(NULL, c("a", "b", "c", "a.1", "b.1", "c.1")), class = c("xts", "zoo")) expect_identical(xm5, empty_with_dims_2x, info = "merge.xts([empty_xts_with_dims 2x]) has correct dims") # merge.zoo() returns an empty object in this case, so we can't expect merge.xts() to match merge.zoo() xm6 <- merge(x0, x0, x0) empty_with_dims_3x <- structure(integer(0), dim = c(0L, 9L), index = .index(x0), dimnames = list(NULL, c("a", "b", "c", "a.1", "b.1", "c.1", "a.2", "b.2", "c.2")), class = c("xts", "zoo")) storage.mode(.index(empty_with_dims_3x)) <- "integer" ## FIXME: this should be 'numeric expect_identical(xm6, empty_with_dims_3x, info = "merge.xts([empty_xts_with_dims 3x]) has correct dims") xm7 <- merge(x0, x, x0) zm7 <- merge(z0, z, z0) expect_equivalent(coredata(xm7), coredata(zm7), info = "merge.xts(empty_named, x_named, empty_named) coredata matches merge.zoo()") expect_equivalent(index(xm7), index(zm7), info = "merge.xts(empty_named, x_named, empty_named) index matches merge.zoo()") xz <- xts(integer(0), .Date(integer(0))) expect_identical(storage.mode(merge(xz, xz)), "integer", info = "merge.xts() on two empty objects should return an object with the same type") ### merging xts with plain vectors x <- xts(matrix(1:9, 3, 3), .Date(17167:17169), dimnames = list(NULL, c("a","b","c"))) z <- as.zoo(x) v <- seq_len(nrow(x)) x1 <- merge(x, v) z1 <- merge(z, v) expect_equivalent(coredata(x1), coredata(z1), info = "merge.xts(x_named, vector) coredata matches merge.zoo()") expect_equivalent(index(x1), index(z1), info = "merge.xts(x_named, vector) index matches merge.zoo()") x2 <- merge(x, x, v) z2 <- merge(z, z, v) expect_equivalent(coredata(x2), coredata(z2), info = "merge.xts(x_named_2x, vector) coredata matches merge.zoo()") expect_equivalent(index(x2), index(z2), info = "merge.xts(x_named_2x, vector) index matches merge.zoo()") x3 <- merge(x, v, x) z3 <- merge(z, v, z) expect_equivalent(coredata(x3), coredata(z3), info = "merge.xts(x_named, vector, x_named) coredata matches merge.zoo()") expect_equivalent(index(x3), index(z3), info = "merge.xts(x_named, vector, x_named) index matches merge.zoo()") xts/inst/tinytest/test-periodicity.R0000644000176200001440000002041414522244665017367 0ustar liggesusersP <- structure( list(difftime = structure(0, units = "secs", class = "difftime"), frequency = 0, start = structure(.POSIXct(1, "UTC"), tclass = c("POSIXct", "POSIXt")), end = structure(.POSIXct(1, "UTC"), tclass = c("POSIXct", "POSIXt")), units = "secs", scale = "seconds", label = "second"), class = "periodicity") test_date <- as.Date("2022-10-15") info_msg <- "test.periodicity_on_one_observation_warns" x <- xts(1, .POSIXct(1, "UTC")) suppressWarnings(p <- periodicity(x)) expect_identical(p, P, info = info_msg) expect_warning(p <- periodicity(x), info = info_msg) info_msg <- "test.periodicity_on_zero_observations_warns" x <- xts(, .POSIXct(numeric(0), "UTC")) suppressWarnings(p <- periodicity(x)) P$start <- NA P$end <- NA expect_identical(p, P, info = info_msg) expect_warning(p <- periodicity(x)) check_periodicity_result <- function(p, units, scale, freq, msg) { info_msg <- paste0(msg, " - units: ", p$units, ", expected: ", units) expect_equivalent(p$units, units, info = info_msg) info_msg <- paste0(msg, " - scale: ", p$scale, ", expected: ", scale) expect_equivalent(p$scale, scale, info = info_msg) info_msg <- paste0(msg, " - frequency: ", p$frequency, ", expected: ", freq) expect_equivalent(p$frequency, freq, info = info_msg) info_msg <- paste0(msg, " - difftime: ", p$difftime, ", expected: ", freq) expect_equivalent(as.numeric(p$difftime), freq, info = info_msg) invisible(NULL) } ############################################################################### info_msg <- "test.periodicity_on_sub_second_data" set.seed(Sys.Date()) for (i in 1:100) { n <- sample(1000, 1) / 1000 #if (n >= eps) n <- 1 p <- periodicity(.xts(seq_len(100), n * seq_len(100))) check_periodicity_result(p, "secs", "seconds", n, info_msg) } # test periodicity between 0.95 and 1, which should round up to 1 #set.seed(Sys.Date()) #for (n in seq(0.9505, 0.99, 0.005)) { # p <- periodicity(.xts(seq_len(100), n * seq_len(100))) # check_periodicity_result(p, "secs", "seconds", n, info_msg) #} ############################################################################### info_msg <- "test.periodicity_on_second_data" i <- seq_len(100) for (n in 1:59) { p <- periodicity(.xts(i, i)) check_periodicity_result(p, "secs", "seconds", 1, info_msg) } ############################################################################### info_msg <- "test.periodicity_on_minute_data" i <- seq_len(100) * 60 for (n in 1:59) { p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "mins", "minute", n, info_msg) } ############################################################################### info_msg <- "test.periodicity_on_hourly_data" i <- seq_len(100) * 3600 for (n in 1:23) { p <- periodicity(.xts(i, n * i)) # NOTE: frequency is in seconds for hourly data (see #54) check_periodicity_result(p, "hours", "hourly", n * 3600, info_msg) } ############################################################################### info_msg <- "test.periodicity_on_daily_data" i <- seq_len(100) * 86400 # NOTE: frequency is in seconds for daily data (see #54) n <- 1 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "daily", n * 86400, info_msg) n <- 2 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "weekly", n * 86400, info_msg) n <- 3 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "weekly", n * 86400, info_msg) ############################################################################### info_msg <- "test.periodicity_on_weekly_data" i <- 7 * seq_len(100) * 86400 # NOTE: frequency is in seconds for weekly data (see #54) n <- 1 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "weekly", n * 86400 * 7, info_msg) n <- 2 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "monthly", n * 86400 * 7, info_msg) n <- 3 p <- periodicity(.xts(i, n * i)) check_periodicity_result(p, "days", "monthly", n * 86400 * 7, info_msg) ############################################################################### info_msg <- "test.periodicity_on_month_data" n <- 1 i <- seq(as.yearmon(test_date) - 12, by = n/12, length.out = 100) x <- xts(i, i) p <- periodicity(x) check_periodicity_result(p, "days", "monthly", 86400 * 31, info_msg) # monthly POSIXct index(x) <- as.POSIXct(i) p <- periodicity(x) check_periodicity_result(p, "days", "monthly", 86400 * 31, info_msg) n <- 2 i <- seq(as.yearmon(test_date) - 12, by = n/12, length.out = 100) x <- xts(i, i) p <- periodicity(x) check_periodicity_result(p, "days", "quarterly", 86400 * 61, info_msg) # monthly POSIXct index(x) <- as.POSIXct(i) p <- periodicity(x) check_periodicity_result(p, "days", "quarterly", 86400 * 61, info_msg) ############################################################################### info_msg <- "test.periodicity_on_quarter_data" n <- 1 i <- seq(as.yearqtr(test_date) - 24, by = n/4, length.out = 100) x <- xts(i, i) p <- periodicity(x) check_periodicity_result(p, "days", "quarterly", 86400 * 91, info_msg) # quarterly POSIXct index(x) <- as.POSIXct(i) p <- periodicity(x) check_periodicity_result(p, "days", "quarterly", 86400 * 91, info_msg) n <- 2 i <- seq(as.yearqtr(test_date) - 48, by = n/4, length.out = 100) p <- periodicity(xts(seq_len(100), i)) check_periodicity_result(p, "days", "yearly", 86400 * 183, info_msg) # quarterly POSIXct index(x) <- as.POSIXct(i) p <- periodicity(x) check_periodicity_result(p, "days", "yearly", 86400 * 183, info_msg) n <- 3 i <- seq(as.yearqtr(test_date) - 50, by = n/4, length.out = 100) p <- periodicity(xts(seq_len(100), i)) check_periodicity_result(p, "days", "yearly", 86400 * 274, info_msg) # quarterly POSIXct index(x) <- as.POSIXct(i) p <- periodicity(x) check_periodicity_result(p, "days", "yearly", 86400 * 274, info_msg) ############################################################################### ### These are the breakpoints in the code as-of 2022-10 ### Woe to the soul who breaks backward compatibility! info_msg <- "test.correct_units_for_edge_cases" test01 <- list(p = 59, units = "secs", scale = "seconds") test02 <- list(p = 60, units = "mins", scale = "minute") test03 <- list(p = 3600, units = "hours", scale = "hourly") test04 <- list(p = 86400 - 1, units = "hours", scale = "hourly") test05 <- list(p = 86400, units = "days", scale = "daily") test06 <- list(p = 604800 - 1, units = "days", scale = "weekly") test07 <- list(p = 2678400 - 1, units = "days", scale = "monthly") test08 <- list(p = 7948800 - 1, units = "days", scale = "quarterly") test09 <- list(p = 7948800, units = "days", scale = "quarterly") test10 <- list(p = 1 + 7948800, units = "days", scale = "yearly") result01 <- periodicity(.xts(, test01$p * seq_len(100))) result02 <- periodicity(.xts(, test02$p * seq_len(100))) result03 <- periodicity(.xts(, test03$p * seq_len(100))) result04 <- periodicity(.xts(, test04$p * seq_len(100))) result05 <- periodicity(.xts(, test05$p * seq_len(100))) result06 <- periodicity(.xts(, test06$p * seq_len(100))) result07 <- periodicity(.xts(, test07$p * seq_len(100))) result08 <- periodicity(.xts(, test08$p * seq_len(100))) result09 <- periodicity(.xts(, test09$p * seq_len(100))) result10 <- periodicity(.xts(, test10$p * seq_len(100))) expect_identical(test01$units, result01$units, info = do.call(paste, c(list(info_msg), test01))) expect_identical(test02$units, result02$units, info = do.call(paste, c(list(info_msg), test02))) expect_identical(test03$units, result03$units, info = do.call(paste, c(list(info_msg), test03))) expect_identical(test04$units, result04$units, info = do.call(paste, c(list(info_msg), test04))) expect_identical(test05$units, result05$units, info = do.call(paste, c(list(info_msg), test05))) expect_identical(test06$units, result06$units, info = do.call(paste, c(list(info_msg), test06))) expect_identical(test07$units, result07$units, info = do.call(paste, c(list(info_msg), test07))) expect_identical(test08$units, result08$units, info = do.call(paste, c(list(info_msg), test08))) expect_identical(test09$units, result09$units, info = do.call(paste, c(list(info_msg), test09))) expect_identical(test10$units, result10$units, info = do.call(paste, c(list(info_msg), test10))) info_msg <- "periodicity warns when 'x' is time-based and contains NA" x <- .Date(c(1:5, NA, 7:10)) expect_warning(periodicity(x), info = info_msg) xts/inst/tinytest/test-zoo.R0000644000176200001440000000372214522244665015655 0ustar liggesusers#sample.zoo <- #structure(c(43.46, 43.3, 43.95, 43.89, 44.01, 43.96, 44.71, 45.02, #45.35, 45.09), .Names = c("264", "263", "262", "261", "260", #"259", "258", "257", "256", "255"), index = structure(c(13516, #13517, 13518, 13521, 13522, 13523, 13524, 13525, 13529, 13530 #), class = "Date"), class = "zoo") # #sample.xts <- #structure(c(43.46, 43.3, 43.95, 43.89, 44.01, 43.96, 44.71, 45.02, #45.35, 45.09), index = structure(c(13516, 13517, 13518, 13521, #13522, 13523, 13524, 13525, 13529, 13530), class = "Date"), class = c("xts", #"zoo"), .CLASS = "zoo", .Dim = c(10L, 1L), .Dimnames = list(c("264", #"263", "262", "261", "260", "259", "258", "257", "256", "255" #), NULL), .ROWNAMES = c("264","263","262", "261", "260", "259", #"258", "257", "256", "255")) # data(sample_matrix) sample.zoo <- zoo(sample_matrix, as.Date(rownames(sample_matrix))) sample.xts <- as.xts(sample.zoo) info_msg <- "test.convert_zoo_to_xts" expect_identical(sample.xts, as.xts(sample.zoo), info = info_msg) info_msg <- "test.convert_zoo_to_xts_j1" expect_identical(sample.xts[,1], as.xts(sample.zoo)[,1], info = info_msg) info_msg <- "test.convert_zoo_to_xts_i1" expect_identical(sample.xts[1,], as.xts(sample.zoo)[1,], info = info_msg) info_msg <- "test.convert_zoo_to_xts_i1j1" expect_identical(sample.xts[1,1], as.xts(sample.zoo)[1,1], info = info_msg) # test.zoo_reclass <- function() { # DEACTIVATED("rownames are not kept yet in current xts-dev") # expect_identical(sample.zoo,reclass(try.xts(sample.zoo)), info = info_msg) # } # test.zoo_reclass_subset_reclass_j1 <- function() { # DEACTIVATED("rownames are not kept yet in current xts-dev") # expect_identical(sample.zoo[,1],reclass(try.xts(sample.zoo))[,1], info = info_msg) # } info_msg <- "test.zoo_reclass_subset_as.xts_j1" expect_identical(sample.zoo[,1], reclass(try.xts(sample.zoo)[,1]), info = info_msg) info_msg <- "test.zoo_reclass_subset_zoo_j1" expect_identical(sample.zoo[,1], reclass(try.xts(sample.zoo[,1])), info = info_msg) xts/inst/tinytest/test-lag.R0000644000176200001440000000245314522244665015611 0ustar liggesusersLAG <- function(x, k=1, na.pad=TRUE) { z <- lag(as.zoo(x), -k, na.pad) dimnames(z) <- NULL as.xts(z) } ### POSIXct index info_msg <- "test.lag_integer_POSIXt" x <- .xts(1:5, 1:5 + 0.0) expect_identical(lag(x), LAG(x), info = info_msg) info_msg <- "test.lag_numeric_POSIXt" x <- .xts(1:5 + 1.0, 1:5 + 0.0) expect_identical(lag(x), LAG(x), info = info_msg) info_msg <- "test.lag_logical_POSIXt" x <- .xts(1:5 > 2, 1:5 + 0.0) expect_identical(lag(x), LAG(x), info = info_msg) ### Date index info_msg <- "test.lag_integer_Date" x <- xts(1:5, as.Date("2016-01-01") - 5:1) expect_identical(lag(x), LAG(x), info = info_msg) info_msg <- "test.lag_numeric_Date" x <- xts(1:5 + 1.0, as.Date("2016-01-01") - 5:1) expect_identical(lag(x), LAG(x), info = info_msg) info_msg <- "test.lag_logical_Date" x <- xts(1:5 > 2, as.Date("2016-01-01") - 5:1) expect_identical(lag(x), LAG(x), info = info_msg) ### Type-check failure errors info_msg <- "test.lag_k_NA" x <- .xts(1:5, 1:5) expect_error(suppressWarnings(lag(x, "a")), # NA introduced by coercion "'k' must be integer", info = info_msg) info_msg <- "test.lag_k_zero_length" x <- .xts(1:5, 1:5) expect_error(suppressWarnings(lag(x, 1L, "a")), # NA introduced by coercion "'na.pad' must be logical", info = info_msg) xts/inst/tinytest/test-tzone.R0000644000176200001440000000476114522244665016211 0ustar liggesusers# These tests check the timezone attribute is attached to the expected # component of the xts object. The xts constructors should no longer add # 'tzone' or '.indexTZ' attributes to the xts object itself. Only the index # should have a 'tzone' attribute. Construct xts objects using structure() to # test behavior when functions encounter xts objects created before 0.10-3. x <- structure(1:5, .Dim = c(5L, 1L), index = structure(1:5, tzone = "", tclass = c("POSIXct", "POSIXt")), .indexCLASS = c("POSIXct", "POSIXt"), tclass = c("POSIXct", "POSIXt"), .indexTZ = "UTC", tzone = "UTC", class = c("xts", "zoo")) info_msg <- "test.get_tzone" expect_identical(tzone(x), "", info = info_msg) info_msg <- "indexTZ(x) warns" expect_warning(indexTZ(x)) info_msg <- "indexTZ(x) <- warns" expect_warning(indexTZ(x) <- "GMT") info_msg <- "tzone(x) <- `foo` removes tzone and .indexTZ from xts object" y <- x tzone(y) <- "GMT" expect_identical(NULL, attr(y, "tzone"), info = info_msg) expect_identical(NULL, attr(y, ".indexTZ"), info = info_msg) info_msg <- "tzone(x) <- `foo` sets the tzone attribute on the index" y <- x tzone(y) <- "GMT" expect_identical("GMT", attr(attr(y, "index"), "tzone"), info = info_msg) expect_null(attr(y, ".indexTZ"), info = "tzone(x) <- `foo` removes .indexTZ attribute from xts object") info_msg <- "tzone(x) <- NULL sets the tzone attribute on the index to '' (empty string)" y <- x tzone(y) <- NULL expect_identical("", attr(attr(y, "index"), "tzone"), info = info_msg) info_msg <- "coredata(x) removes tzone and .indexTZ from xts object" y <- coredata(x) expect_identical(NULL, attr(y, "tzone"), info = info_msg) expect_identical(NULL, attr(y, ".indexTZ"), info = info_msg) info_msg <- "xtsAttributes(x) does not include tzone or .indexTZ" y <- xtsAttributes(x) expect_identical(NULL, y$tzone, info = info_msg) expect_identical(NULL, y$.indexTZ, info = info_msg) info_msg <- "xtsAttributes(x) <- 'foo' removes tzone and .indexTZ" y <- x xtsAttributes(y) <- xtsAttributes(x) expect_identical(NULL, attr(y, "tzone"), info = info_msg) expect_identical(NULL, attr(y, ".indexTZ"), info = info_msg) info_msg <- "tzone(x) <- `foo` always creates a character tzone" x <- "hello" tzone(x) <- 1 expect_identical(storage.mode(attr(x, "tzone")), "character", info = info_msg) info_msg <- "zero-width subset has the same tzone as the input" target <- "Ima/Tzone" x <- .xts(1:10, 1:10, tzone = target) y <- x[,0] expect_equal(target, tzone(y), info = info_msg) xts/inst/tinytest/test-na.omit.R0000644000176200001440000000211214522244665016403 0ustar liggesusersxdata <- .xts(c(1, NA, 3, 4, 5, 6), c(0, 4, 10, 19, 24, 29)) xindex <- .xts(rep(0, 5), c(5, 10, 20, 25, 28)) types <- c("double", "integer", "character", "logical") info_msg <- "test.naomit" for (type in types) { xdat <- xdata xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) x <- na.omit(xdat) z <- na.omit(zdat) # na.omit.xts adds "index" attribute to the "na.action" attribute attr(attr(x, "na.action"), "index") <- NULL #expect_identical(x, as.xts(z)) # FALSE (attribute order differs) expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } info_msg <- "test.naomit_by_column" for (type in types) { xdat <- xdata xidx <- xindex storage.mode(xdat) <- storage.mode(xidx) <- type zdat <- as.zoo(xdat) zidx <- as.zoo(xidx) x <- na.omit(merge(one = xdat, two = xdat)) z <- na.omit(merge(one = zdat, two = zdat)) # na.omit.xts adds "index" attribute to the "na.action" attribute attr(attr(x, "na.action"), "index") <- NULL expect_equal(x, as.xts(z), info = paste(info_msg, "-", type)) } xts/inst/tinytest/test-plot.R0000644000176200001440000000320714540670206016014 0ustar liggesusers# Tests for plotting functions data(sample_matrix) x <- as.xts(sample_matrix, dateFormat = "Date") # axTicksByTime info_msg <- "test.format_xts_yearqtr" xq <- to.quarterly(x) xtbt <- axTicksByTime(xq) expect_identical(names(xtbt), c("2007-Q1", "2007-Q2"), info = info_msg) info_msg <- "test.format_zoo_yearqtr" xq <- to.quarterly(x) xtbt <- axTicksByTime(as.zoo(xq)) expect_identical(names(xtbt), c("2007-Q1", "2007-Q2"), info = info_msg) info_msg <- "test.axTicksByTime_ticks.on_quarter" tick_marks <- setNames(c(1, 4, 7, 10, 13, 16, 19, 22, 25, 25), c("\nJan\n2016", "\nApr\n2016", "\nJul\n2016", "\nOct\n2016", "\nJan\n2017", "\nApr\n2017", "\nJul\n2017", "\nOct\n2017", "\nJan\n2018", "\nJan\n2018")) if (.Platform$OS.type != "unix") { names(tick_marks) <- gsub("\n(.*)\n", "\\1 ", names(tick_marks)) } ym <- as.yearmon("2018-01") - 24:0 / 12 x <- xts(seq_along(ym), ym) xtbt <- axTicksByTime(x, ticks.on = "quarters") expect_identical(xtbt, tick_marks, info = info_msg) info_msg <- "test.xlim_set_before_rendering" target <- c(86400.0, 864000.0) p <- plot(xts(1:10, .Date(1:10))) expect_equivalent(target, p$get_xlim(), info = info_msg) info_msg <- "test.ylim_set_before_rendering" x <- rnorm(10) p <- plot(xts(x, .Date(1:10))) expect_equivalent(range(x), p$get_ylim(), info = info_msg) get_xcoords_respects_object_tzone <- function() { # random timezone tz <- sample(OlsonNames(), 1) dttm <- seq(as.POSIXct("2023-01-01 01:23:45"), , 1, 5) x <- xts(c(5, 1, 2, 4, 3), dttm, tzone = tz) print(p <- plot(x)) expect_identical(tz, tzone(p$get_xcoords(x)), info = paste("TZ =", tz)) } get_xcoords_respects_object_tzone() xts/inst/tinytest/test-tformat.R0000644000176200001440000000346714522244665016530 0ustar liggesusers# These tests check the 'tformat' attribute is attached to the expected # component of the xts object. The xts constructors should no longer add the # '.indexFORMAT' attribute to the xts object itself. Only the index should # have a 'tformat' attribute. Construct xts objects using structure() to # test behavior when functions encounter xts objects created before 0.10-3. x <- structure(1:5, .Dim = c(5L, 1L), index = structure(1:5, tzone = "", tclass = c("POSIXct", "POSIXt"), tformat = "%Y-%m-%d"), .indexCLASS = c("POSIXct", "POSIXt"), tclass = c("POSIXct", "POSIXt"), .indexTZ = "UTC", tzone = "UTC", .indexFORMAT = "%Y-%m-%d %H:%M:%S", class = c("xts", "zoo")) info_msg <- "test.get_tformat" expect_identical(tformat(x), "%Y-%m-%d", info = info_msg) info_msg <- "test.get_indexFORMAT_warns" expect_warning(indexFormat(x), info = info_msg) info_msg <- "test.set_indexFORMAT_warns" expect_warning(indexFormat(x) <- "GMT", info = info_msg) info_msg <- "test.set_tformat_drops_xts_indexFORMAT" y <- x tformat(y) <- "%Y-%m-%d %H:%M" expect_identical(NULL, attr(y, ".indexFORMAT"), info = info_msg) info_msg <- "test.set_tformat_changes_index_tformat" y <- x fmt <- "%Y-%m-%d %H:%M" tformat(y) <- fmt expect_identical(fmt, attr(attr(y, "index"), "tformat"), info = info_msg) info_msg <- "test.get_coredata_drops_xts_indexFORMAT" y <- coredata(x) expect_identical(NULL, attr(y, ".indexFORMAT"), info = info_msg) info_msg <- "test.get_xtsAttributes_excludes_indexFORMAT" y <- xtsAttributes(x) expect_identical(NULL, y$.indexFORMAT, info = info_msg) info_msg <- "test.set_xtsAttributes_removes_indexFORMAT" y <- x xtsAttributes(y) <- xtsAttributes(x) expect_identical(NULL, attr(y, ".indexFORMAT"), info = info_msg) xts/inst/tinytest/test-tclass.R0000644000176200001440000000575014527166171016342 0ustar liggesusers# These tests check the time class attribute is attached to the expected # component of the xts object. The xts constructors should no longer add # 'tclass' or '.indexClass' attributes to the xts object itself. Only the index # should have a 'tclass' attribute. Construct xts objects using structure() to # test behavior when functions encounter xts objects created before 0.10-3. x <- structure(1:5, .Dim = c(5L, 1L), index = structure(1:5, tzone = "", tclass = c("POSIXct", "POSIXt")), .indexCLASS = c("POSIXct", "POSIXt"), tclass = c("POSIXct", "POSIXt"), .indexTZ = "UTC", tzone = "UTC", class = c("xts", "zoo")) info_msg <- "tclass(x) gets tclass attribute from index, not the xts object" expect_identical(tclass(x), c("POSIXct", "POSIXt"), info = info_msg) info_msg <- "indexClass(x) warns" expect_warning(indexClass(x), info = info_msg) info_msg <- "indexClass(x) <- 'Date' warns" expect_warning(indexClass(x) <- "Date", info = info_msg) info_msg <- "tclass(x) <- 'POSIXct' removes tclass and .indexCLASS from xts object" y <- x tclass(y) <- "POSIXct" expect_identical(NULL, attr(y, "tclass"), info = info_msg) expect_identical(NULL, attr(y, ".indexCLASS"), info = info_msg) info_msg <- "tclass<- sets tclass attribute on index" y <- x tclass(y) <- "Date" expect_identical("Date", attr(attr(y, "index"), "tclass"), info = info_msg) info_msg <- "tclass<- removes .indexCLASS attribute from xts object" expect_identical("Date", attr(.index(y), "tclass"), info = info_msg) info_msg <- "coredata(x) removes tclass and .indexCLASS from xts object" y <- coredata(x) expect_identical(NULL, attr(y, "tclass"), info = info_msg) expect_identical(NULL, attr(y, ".indexCLASS"), info = info_msg) info_msg <- "xtsAttributes(x) does not include tclass or .indexCLASS" y <- xtsAttributes(x) expect_identical(NULL, y$tclass, info = info_msg) expect_identical(NULL, y$.indexCLASS, info = info_msg) info_msg <- "xtsAttributes(x) <- 'foo' removes tclass and .indexCLASS" y <- x xtsAttributes(y) <- xtsAttributes(x) expect_identical(NULL, attr(y, "tclass"), info = info_msg) expect_identical(NULL, attr(y, ".indexCLASS"), info = info_msg) info_msg <- "tclass(x) <- `foo` always creates a character tclass" x <- "hello" tclass(x) <- 1 expect_identical(storage.mode(attr(x, "tclass")), "character") info_msg <- "zero-width subset has the same tclass as the input" target <- "Imatclass" x <- .xts(1:10, 1:10, tclass = target) y <- x[,0] expect_equal(target, tclass(y)) info_msg <- "tclass() on object with no tclass/.indexCLASS returns POSIXct" x <- structure(1:5, .Dim = c(5L, 1L), index = 1:5, class = c("xts", "zoo")) expect_warning(xtc <- tclass(x), "index does not have a 'tclass' attribute") expect_identical(c("POSIXct", "POSIXt"), xtc) info_msg <- "tclass<-() updates index" x <- xts(1, .POSIXct(14400, tz = "Europe/Berlin")) tclass(x) <- "Date" expect_identical(as.numeric(.index(x)), 0, info = paste(info_msg, "values")) expect_identical(tzone(x), "UTC", info = paste(info_msg, "timezone")) xts/inst/tinytest/test-irts.R0000644000176200001440000000210314522244665016017 0ustar liggesusershave_tseries <- suppressPackageStartupMessages({ # tseries imports quantmod. Silence this message when quantmod is loaded: # # Registered S3 method overwritten by 'quantmod': # method from # as.zoo.data.frame zoo # # So I don't get confused (again) about why xts' tests load quantmod requireNamespace("tseries", quietly = TRUE) }) if (have_tseries) { library(xts) data(sample_matrix) sample.irts <- tseries::irts(as.POSIXct(rownames(sample_matrix)),sample_matrix) sample.irts.xts <- as.xts(sample.irts) info_msg <- "test.convert_irts_to_xts <- function()" expect_identical(sample.irts.xts,as.xts(sample.irts), info = info_msg) info_msg <- "test.convert_irts_to_xts_j1" expect_identical(sample.irts.xts[,1],as.xts(sample.irts)[,1], info = info_msg) info_msg <- "test.convert_irts_to_xts_i1" expect_identical(sample.irts.xts[1,],as.xts(sample.irts)[1,], info = info_msg) info_msg <- "test.convert_irts_to_xts_i1j1" expect_identical(sample.irts.xts[1,1],as.xts(sample.irts)[1,1], info = info_msg) } # requireNamespace xts/inst/tinytest/test-na.fill.R0000644000176200001440000000122514522244665016365 0ustar liggesusersinfo_msg <- "na.fill.xts() matches na.fill.zoo() when object has 1 column and 'fill' is scalar" x <- .xts(1:20, 1:20) is.na(x) <- sample(20, 10) z <- as.zoo(x) x_out <- coredata(na.fill(x, 0)) z_out <- coredata(na.fill(z, 0)) expect_equal(z_out, x_out, info = info_msg) info_msg <- "na.fill.xts() matches na.fill.zoo() when object has 2 columns and 'fill' is scalar" x <- .xts(cbind(1:10, 1:10), 1:10) is.na(x[,1]) <- sample(10, 5) is.na(x[,2]) <- sample(10, 5) z <- as.zoo(x) x_out <- coredata(na.fill(x, 0)) z_out <- coredata(na.fill(z, 0)) # z_out has dimnames (both NULL) for some reason dimnames(z_out) <- NULL expect_equal(z_out, x_out, info = info_msg) xts/inst/tinytest/test-data.frame.R0000644000176200001440000000714714522244665017055 0ustar liggesusersdata(sample_matrix) sample.data.frame <- data.frame(sample_matrix[1:15,]) sample.xts <- as.xts(sample.data.frame) info_msg <- "test.convert_data.frame_to_xts" expect_identical(sample.xts, as.xts(sample.data.frame), info_msg) info_msg <- "test.convert_data.frame_to_xts_j1" expect_identical(sample.xts[,1], as.xts(sample.data.frame)[,1], info_msg) info_msg <- "test.convert_data.frame_to_xts_i1" expect_identical(sample.xts[1,], as.xts(sample.data.frame)[1,], info_msg) info_msg <- "test.convert_data.frame_to_xts_i1j1" expect_identical(sample.xts[1,1], as.xts(sample.data.frame)[1,1], info_msg) info_msg <- "test.data.frame_reclass" expect_identical(sample.data.frame, reclass(try.xts(sample.data.frame)), info_msg) info_msg <- "test.data.frame_reclass_subset_reclass_j1" expect_identical(sample.data.frame[,1], reclass(try.xts(sample.data.frame))[,1], info_msg) # subsetting to 1 col converts to simple numeric - can't successfully handle info_msg <- "test.data.frame_reclass_subset_as.xts_j1" expect_identical(sample.data.frame[,1,drop=FALSE], reclass(try.xts(sample.data.frame)[,1]), info_msg) info_msg <- "test.data.frame_reclass_subset_data.frame_j1" # subsetting results in a vector, so can't be converted to xts expect_error(try.xts(sample.data.frame[,1]), info = info_msg) # check for as.xts.data.frame when order.by is specified info_msg <- "test.convert_data.frame_to_xts_order.by_POSIXlt" orderby = as.POSIXlt(rownames(sample.data.frame)) x <- as.xts(sample.data.frame, order.by = orderby) # tz = "" by default for as.POSIXlt.POSIXct y <- xts(coredata(sample.xts), as.POSIXlt(index(sample.xts))) expect_identical(y, x, info_msg) info_msg <- "test.convert_data.frame_to_xts_order.by_POSIXct" orderby = as.POSIXct(rownames(sample.data.frame)) x <- as.xts(sample.data.frame, order.by = orderby) expect_identical(sample.xts, x, info_msg) info_msg <- "test.convert_data.frame_to_xts_order.by_Date" # tz = "UTC" by default for as.Date.POSIXct (y), but # tz = "" by default for as.Date.character (orderby) orderby = as.Date(rownames(sample.data.frame)) x <- as.xts(sample.data.frame, order.by = orderby) y <- xts(coredata(sample.xts), as.Date(index(sample.xts), tz = "")) expect_identical(y, x, info_msg) ### data.frame with Date/POSIXct column df_date_col <- data.frame(Date = as.Date(rownames(sample.data.frame)), sample.data.frame, row.names = NULL) info_msg <- "convert data.frame to xts from Date column" x <- as.xts(df_date_col) y <- xts(coredata(sample.xts), as.Date(index(sample.xts), tz = "")) expect_equal(y, x, info = info_msg) info_msg <- "convert data.frame to xts from POSIXct column" dttm <- as.POSIXct(rownames(sample.data.frame), tz = "UTC") + runif(15)*10000 df_pxct_col <- data.frame(Timestamp = dttm, sample.data.frame, row.names = NULL) x <- as.xts(df_pxct_col) y <- xts(coredata(sample.xts), dttm) expect_equal(y, x, info = info_msg) info_msg <- "convert data.frame to xts errors when no rownames or column" df_no_col <- data.frame(sample.data.frame, row.names = NULL) expect_error(as.xts(df_no_col), pattern = "could not convert row names to a date-time and could not find a time-based column", info = info_msg) info_msg <- "keep column name for data.frame with one non-time-based column" x <- as.xts(df_date_col[, 1:2]) expect_identical(names(x), "Open", info = info_msg) xts/inst/tinytest/test-subset.R0000644000176200001440000003210214522244665016345 0ustar liggesusers### i = missing, j = NA, object has column names ### See #181 info_msg <- "test.i_missing_j_NA_has_colnames" iina <- .xts(matrix(NA_integer_, 5, 2), 1:5) idna <- .xts(matrix(NA_integer_, 5, 2), 1.0 * 1:5) dina <- .xts(matrix(NA_real_, 5, 2), 1:5) ddna <- .xts(matrix(NA_real_, 5, 2), 1.0 * 1:5) colnames(iina) <- colnames(idna) <- colnames(dina) <- colnames(ddna) <- rep(NA_character_, 2) # int data, int index ii <- .xts(matrix(1:10, 5, 2), 1:5) colnames(ii) <- c("a", "b") expect_identical(ii[, NA], iina, info = paste(info_msg, "int data, int index")) expect_identical(ii[, 1][, NA], iina[, 1], info = paste(info_msg, "int data, int index")) # int data, dbl index id <- .xts(matrix(1:10, 5, 2), 1.0 * 1:5) colnames(id) <- c("a", "b") expect_identical(id[, NA], idna, info = paste(info_msg, "int data, dbl index")) expect_identical(id[, 1][, NA], idna[, 1], info = paste(info_msg, "int data, dbl index")) # dbl data, int index di <- .xts(1.0 * matrix(1:10, 5, 2), 1:5) colnames(di) <- c("a", "b") expect_identical(di[, NA], dina, info = paste(info_msg, "dbl data, int index")) expect_identical(di[, 1][, NA], dina[, 1], info = paste(info_msg, "dbl data, int index")) # dbl data, dbl index dd <- .xts(1.0 * matrix(1:10, 5, 2), 1.0 * 1:5) colnames(dd) <- c("a", "b") expect_identical(dd[, NA], ddna, info = paste(info_msg, "dbl data, dbl index")) expect_identical(dd[, 1][, NA], ddna[, 1], info = paste(info_msg, "dbl data, dbl index")) ### i = missing, j = NA, object does not have column names ### See #97 info_msg <- "test.i_missing_j_NA_no_colnames" iina <- .xts(matrix(NA_integer_, 5, 2), 1:5) idna <- .xts(matrix(NA_integer_, 5, 2), 1.0 * 1:5) dina <- .xts(matrix(NA_real_, 5, 2), 1:5) ddna <- .xts(matrix(NA_real_, 5, 2), 1.0 * 1:5) # int data, int index ii <- .xts(matrix(1:10, 5, 2), 1:5) expect_identical(ii[, NA], iina, info = paste(info_msg, "int data, int index")) expect_identical(ii[, 1][, NA], iina[, 1], info = paste(info_msg, "int data, int index")) # int data, dbl index id <- .xts(matrix(1:10, 5, 2), 1.0 * 1:5) expect_identical(id[, NA], idna, info = paste(info_msg, "int data, dbl index")) expect_identical(id[, 1][, NA], idna[, 1], info = paste(info_msg, "int data, dbl index")) # dbl data, int index di <- .xts(1.0 * matrix(1:10, 5, 2), 1:5) expect_identical(di[, NA], dina, info = paste(info_msg, "dbl data, int index")) expect_identical(di[, 1][, NA], dina[, 1], info = paste(info_msg, "dbl data, int index")) # dbl data, dbl index dd <- .xts(1.0 * matrix(1:10, 5, 2), 1.0 * 1:5) expect_identical(dd[, NA], ddna, info = paste(info_msg, "dbl data, dbl index")) expect_identical(dd[, 1][, NA], ddna[, 1], info = paste(info_msg, "dbl data, dbl index")) ### i = integer, j = NA, object has column names ### See #97 info_msg <- "test.i_integer_j_NA_has_colnames" iina <- .xts(matrix(NA_integer_, 5, 2), 1:5) idna <- .xts(matrix(NA_integer_, 5, 2), 1.0 * 1:5) dina <- .xts(matrix(NA_real_, 5, 2), 1:5) ddna <- .xts(matrix(NA_real_, 5, 2), 1.0 * 1:5) colnames(iina) <- colnames(idna) <- colnames(dina) <- colnames(ddna) <- rep(NA_character_, 2) i <- 1:3 # int data, int index ii <- .xts(matrix(1:10, 5, 2), 1:5) colnames(ii) <- c("a", "b") expect_identical(ii[i, NA], iina[i,], info = paste(info_msg, "int data, int index")) expect_identical(ii[i, 1][, NA], iina[i, 1], info = paste(info_msg, "int data, int index")) # int data, dbl index id <- .xts(matrix(1:10, 5, 2), 1.0 * 1:5) colnames(id) <- c("a", "b") expect_identical(id[i, NA], idna[i,], info = paste(info_msg, "int data, dbl index")) expect_identical(id[i, 1][, NA], idna[i, 1], info = paste(info_msg, "int data, dbl index")) # dbl data, int index di <- .xts(1.0 * matrix(1:10, 5, 2), 1:5) colnames(di) <- c("a", "b") expect_identical(di[i, NA], dina[i,], info = paste(info_msg, "dbl data, int index")) expect_identical(di[i, 1][, NA], dina[i, 1], info = paste(info_msg, "dbl data, int index")) # dbl data, dbl index dd <- .xts(1.0 * matrix(1:10, 5, 2), 1.0 * 1:5) colnames(dd) <- c("a", "b") expect_identical(dd[i, NA], ddna[i,], info = paste(info_msg, "dbl data, dbl index")) expect_identical(dd[i, 1][, NA], ddna[i, 1], info = paste(info_msg, "dbl data, dbl index")) ### i = integer, j = NA, object does not have column names ### See #97 info_msg <- "test.i_integer_j_NA_no_colnames" iina <- .xts(matrix(NA_integer_, 5, 2), 1:5) idna <- .xts(matrix(NA_integer_, 5, 2), 1.0 * 1:5) dina <- .xts(matrix(NA_real_, 5, 2), 1:5) ddna <- .xts(matrix(NA_real_, 5, 2), 1.0 * 1:5) i <- 1:3 # int data, int index ii <- .xts(matrix(1:10, 5, 2), 1:5) expect_identical(ii[i, NA], iina[i,], info = paste(info_msg, "int data, int index")) expect_identical(ii[i, 1][, NA], iina[i, 1], info = paste(info_msg, "int data, int index")) # int data, dbl index id <- .xts(matrix(1:10, 5, 2), 1.0 * 1:5) expect_identical(id[i, NA], idna[i,], info = paste(info_msg, "int data, dbl index")) expect_identical(id[i, 1][, NA], idna[i, 1], info = paste(info_msg, "int data, dbl index")) # dbl data, int index di <- .xts(1.0 * matrix(1:10, 5, 2), 1:5) expect_identical(di[i, NA], dina[i,], info = paste(info_msg, "dbl data, int index")) expect_identical(di[i, 1][, NA], dina[i, 1], info = paste(info_msg, "dbl data, int index")) # dbl data, dbl index dd <- .xts(1.0 * matrix(1:10, 5, 2), 1.0 * 1:5) expect_identical(dd[i, NA], ddna[i,], info = paste(info_msg, "dbl data, dbl index")) expect_identical(dd[i, 1][, NA], ddna[i, 1], info = paste(info_msg, "dbl data, dbl index")) info_msg <- "test.i_0" x <- .xts(matrix(1:10, 5, 2), 1:5) z <- as.zoo(x) xz0 <- as.xts(z[0,]) expect_equal(x[0,], xz0, info = info_msg) ### Subset by non-numeric classes X <- xts(1:5, as.Date("2018-04-21") - 5:1) info_msg <- "test.i_character" x <- X for (r in c(1L, 3L, 5L)) { y <- x[r,] i <- as.character(index(y)) expect_identical(y, x[i, ], info = paste(info_msg, "i =", r)) } info_msg <- "test.i_asis_character" x <- X for (r in c(1L, 3L, 5L)) { y <- x[r,] i <- as.character(index(y)) expect_identical(y, x[I(i), ], info = paste(info_msg, "r =", r)) } info_msg <- "test.i_Date" x <- X for (r in c(1L, 3L, 5L)) { y <- x[r,] i <- index(y) expect_identical(y, x[i, ], info = paste(info_msg, "r =", r)) } info_msg <- "test.i_POSIXct" x <- X index(x) <- as.POSIXct(index(x), tz = "UTC") for (r in c(1L, 3L, 5L)) { y <- x[r,] i <- index(y) expect_identical(y, x[i, ], info = paste(info_msg, "r =", r)) } info_msg <- "test.i_POSIXlt" x <- X index(x) <- as.POSIXlt(index(x), tz = "UTC") for (r in c(1L, 3L, 5L)) { y <- x[r,] i <- index(y) expect_identical(y, x[i, ], info = paste(info_msg, "r =", r)) } ### invalid date/time info_msg <- "test.i_invalid_date_string" x <- xts(1:10, as.Date("2015-02-20")+0:9) expect_warning(y <- x["2012-02-30"], pattern = "cannot determine first and last time") expect_identical(y, x[NA,], info = info_msg) info_msg <- "test.i_only_range_separator_or_empty_string" x <- xts(1:10, as.Date("2015-02-20")+0:9) y <- x["/",] expect_identical(y, x, info = paste(info_msg, "sep = '/'")) y <- x["::",] expect_identical(y, x, info = paste(info_msg, "sep = '::'")) y <- x["",] expect_identical(y, x, info = paste(info_msg, "sep = ''")) info_msg <- "test.i_date_range_open_end" x <- xts(1:10, as.Date("2015-02-20")+0:9) y <- x["2015-02-23/",] expect_identical(y, x[4:10,], info = info_msg) info_msg <- "test.i_date_range_open_start" x <- xts(1:10, as.Date("2015-02-20")+0:9) y <- x["/2015-02-26",] expect_identical(y, x[1:7,], info = info_msg) ### subset empty xts info_msg <- "empty xts subset by datetime matches zoo" d0 <- as.Date(integer()) zl <- xts(, d0) empty <- as.xts(as.zoo(zl)[i,]) i <- Sys.Date() expect_identical(zl[i,], empty, info = paste(info_msg, "i = Date, [i,]")) expect_identical(zl[i], empty, info = paste(info_msg, "i = Date, [i]")) i <- Sys.time() expect_identical(zl[i,], empty, info = paste(info_msg, "i = POSIXct, [i,]")) expect_identical(zl[i], empty, info = paste(info_msg, "i = POSIXct, [i]")) info_msg <- "empty xts subset by 0 matches zoo" d0 <- as.Date(integer()) zl <- xts(, d0) empty <- as.xts(as.zoo(zl)[0,]) expect_identical(zl[0,], empty, info = paste(info_msg, "[i,]")) expect_identical(zl[0], empty, info = paste(info_msg, "[i]")) info_msg <- "empty xts subset by -1 matches zoo" d0 <- as.Date(integer()) zl <- xts(, d0) empty <- as.xts(as.zoo(zl)[i,]) expect_identical(zl[-1,], empty, info = paste(info_msg, "[-1,]")) expect_identical(zl[-1], empty, info = paste(info_msg, "[-1]")) info_msg <- "empty xts subset by NA matches zoo" d0 <- as.Date(integer()) zl <- xts(, d0) empty <- as.xts(as.zoo(zl)[i,]) expect_identical(zl[NA,], empty, info = paste(info_msg, "[NA,]")) expect_identical(zl[NA], empty, info = paste(info_msg, "[NA]")) info_msg <- "empty xts subset by NULL matches zoo" d0 <- as.Date(integer()) zl <- xts(, d0) empty <- as.xts(as.zoo(zl)[i,]) expect_identical(zl[NULL,], empty, info = paste(info_msg, "[NULL,]")) expect_identical(zl[NULL], empty, info = paste(info_msg, "[NULL]")) info_msg <- "test.duplicate_index_duplicate_i" dates <- structure(c(15770, 16257, 16282, 16291, 16296, 16296, 16298, 16301, 16432, 16452), class = "Date") x <- xts(c(1, 2, 2, 3, 3, 3, 3, 3, 4, 4), dates) dupdates <- structure(c(15770, 16257, 16282, 16291, 16296, 16296, 16296, 16296, 16298, 16301, 16432, 16452), class = "Date") y <- xts(c(1, 2, 2, 3, 3, 3, 3, 3, 3, 3, 4, 4), dupdates) expect_identical(x[index(x),], y, info = info_msg) ### Test dispatch to zoo for yearmon, yearqtr tclass info_msg <- "test.window_yearmon_yearqtr_tclass_dispatches_to_zoo" i1 <- seq(as.yearmon(2007), by = 1/12, length.out = 36) x1 <- xts(1:36, i1) i2 <- seq(as.yearqtr(2007), by = 1/4, length.out = 36) x2 <- xts(1:36, i2) r1 <- x1["2015"] r2 <- x2["2015"] ########## results are empty objects ########## ### zoo supports numeric start for yearmon and yearqtr w1 <- window(x1, start = 2015.01) # to window.zoo() w2 <- window(x2, start = 2015.1) # to window.zoo() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, numeric start, empty range")) expect_equal(r2, w2, info = paste(info_msg, "window, yearqtr, numeric start, empty range")) w1 <- window(x1, start = "2015-01-01") # to window.xts() w2 <- window(x2, start = "2015Q1") # to window.zoo() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, character start, empty range")) expect_equal(r2, w2, info = paste(info_msg, "window, yearqtr, character start, empty range")) w1 <- window(x1, start = "2015-01-01", end = NA) # to window.xts() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, character start with end = NA, empty range")) ########## results are *not* empty objects ########## r1 <- x1["2011/"] r2 <- x2["2011/"] w1 <- window(x1, start = 2011.01) # to window.zoo() w2 <- window(x2, start = 2011.1) # to window.zoo() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, numeric start")) expect_equal(r2, w2, info = paste(info_msg, "window, yearqtr, numeric start")) w1 <- window(x1, start = "2011-01-01") # to window.xts() w2 <- window(x2, start = "2011Q1") # to window.zoo() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, character start")) expect_equal(r2, w2, info = paste(info_msg, "window, yearqtr, character start")) w1 <- window(x1, start = "2011-01-01", end = NA) # to window.xts() expect_equal(r1, w1, info = paste(info_msg, "window, yearmon, character start with end = NA")) info_msg <- "test.zero_width_subset_does_not_drop_class" target <- c("custom", "xts", "zoo") x <- .xts(1:10, 1:10, class = target) y <- x[,0] expect_equal(target, class(y), info = info_msg) info_msg <- "test.zero_width_subset_does_not_drop_user_attributes" x <- .xts(1:10, 1:10, my_attr = "hello") y <- x[,0] expect_equal("hello", attr(y, "my_attr"), info = info_msg) info_msg <- "test.zero_length_subset_xts_returns_same_tclass" x <- .xts(matrix(1)[0,], integer(0), "Date") expect_equal(tclass(x[0,]), "Date") x <- .xts(matrix(1)[0,], integer(0), "POSIXct", "America/Chicago") expect_equal(tclass(x[0,]), "POSIXct") expect_equal(tzone(x[0,]), "America/Chicago") info_msg <- "test.zero_length_subset_returns_same_storage_mode" tf <- c(TRUE, FALSE) # integer sm <- "integer" x <- .xts(matrix(integer(0), 0), integer(0)) expect_equal(storage.mode(x[0, ]), sm, info = paste(info_msg, ": x[0,]")) expect_equal(storage.mode(x[0, 0]), sm, info = paste(info_msg, ": x[0, 0")) expect_equal(storage.mode(x[0, FALSE]), sm, info = paste(info_msg, ": x[0, FALSE]")) x <- .xts(matrix(integer(0), 0, 2), integer(0)) expect_equal(storage.mode(x[0,]), sm, info = paste(info_msg, ": x[0,]")) expect_equal(storage.mode(x[0, 1]), sm, info = paste(info_msg, ": x[0, 1]")) expect_equal(storage.mode(x[0, tf]), sm, nfo = paste(info_msg, ": x[0, c(TRUE, FALSE)]")) # double sm <- "double" x <- .xts(matrix(numeric(0), 0), integer(0)) expect_equal(storage.mode(x[0, ]), sm, info = paste(info_msg, ": x[0,]")) expect_equal(storage.mode(x[0, 0]), sm, info = paste(info_msg, ": x[0, 0]")) expect_equal(storage.mode(x[0, FALSE]), sm, info = paste(info_msg, ": x[0, FALSE]")) x <- .xts(matrix(numeric(0), 0, 2), integer(0)) expect_equal(storage.mode(x[0,]), sm, info = paste(info_msg, ": x[0,]")) expect_equal(storage.mode(x[0, 1]), sm, info = paste(info_msg, ": x[0, 1]")) expect_equal(storage.mode(x[0, tf]), sm, info = paste(info_msg, ": x[0, c(TRUE, FALSE)]")) xts/inst/tinytest/test-binsearch.R0000644000176200001440000000626014522244665017004 0ustar liggesusersna <- NA_integer_ # vector with even length, odd length # no/yes result (potential infinite loop) # https://www.topcoder.com/community/data-science/data-science-tutorials/binary-search/ info_msg <- "integer predicate no yes stops" ans <- 2L ivec <- 3:4 ikey <- ivec[ans] expect_identical(ans, xts:::binsearch(ikey, ivec, TRUE), paste(info_msg, TRUE)) expect_identical(ans, xts:::binsearch(ikey, ivec, FALSE), paste(info_msg, FALSE)) # small steps between vector elements (test that we actually stop) info_msg <- "test.double_with_small_delta_stops" ans <- 10L dvec <- 1 + (-10:10 / 1e8) dkey <- dvec[ans] expect_identical(ans, xts:::binsearch(dkey, dvec, TRUE)) expect_identical(ans, xts:::binsearch(dkey, dvec, FALSE)) info_msg <- "test.find_first_zero_even_length" ivec <- sort(c(0L, -3:5L)) dvec <- ivec * 1.0 expect_identical(4L, xts:::binsearch(0L, ivec, TRUE)) expect_identical(4L, xts:::binsearch(0.0, dvec, TRUE)) info_msg <- "test.find_last_zero_even_length" ivec <- sort(c(0L, -3:5L)) dvec <- ivec * 1.0 expect_identical(5L, xts:::binsearch(0L, ivec, FALSE)) expect_identical(5L, xts:::binsearch(0.0, dvec, FALSE)) info_msg <- "test.find_first_zero_odd_length" ivec <- sort(c(0L, -3:5L)) dvec <- ivec * 1.0 expect_identical(4L, xts:::binsearch(0L, ivec, TRUE)) expect_identical(4L, xts:::binsearch(0.0, dvec, TRUE)) info_msg <- "test.find_last_zero_odd_length" ivec <- sort(c(0L, -3:5L)) dvec <- ivec * 1.0 expect_identical(5L, xts:::binsearch(0L, ivec, FALSE)) expect_identical(5L, xts:::binsearch(0.0, dvec, FALSE)) # key is outside of vector info_msg <- "test.key_less_than_min" ivec <- 1:6 expect_identical(1L, xts:::binsearch(-9L, ivec, TRUE)) expect_identical(na, xts:::binsearch(-9L, ivec, FALSE)) dvec <- ivec * 1.0 expect_identical(1L, xts:::binsearch(-9, dvec, TRUE)) expect_identical(na, xts:::binsearch(-9, dvec, FALSE)) info_msg <- "test.key_greater_than_max" ivec <- 1:6 expect_identical(na, xts:::binsearch( 9L, ivec, TRUE)) expect_identical(6L, xts:::binsearch( 9L, ivec, FALSE)) dvec <- ivec * 1.0 expect_identical(na, xts:::binsearch( 9, dvec, TRUE)) expect_identical(6L, xts:::binsearch( 9, dvec, FALSE)) # key is NA info_msg <- "test.key_is_NA" ivec <- 1:6 ikey <- NA_integer_ expect_identical(na, xts:::binsearch(ikey, ivec, TRUE)) expect_identical(na, xts:::binsearch(ikey, ivec, FALSE)) dvec <- ivec * 1.0 dkey <- NA_real_ expect_identical(na, xts:::binsearch(dkey, dvec, TRUE)) expect_identical(na, xts:::binsearch(dkey, dvec, FALSE)) # key is zero-length info_msg <- "test.key_is_zero_length" # have empty key return NA ivec <- 1:6 ikey <- integer() expect_identical(na, xts:::binsearch(ikey, ivec, TRUE)) expect_identical(na, xts:::binsearch(ikey, ivec, FALSE)) dvec <- ivec * 1.0 dkey <- double() expect_identical(na, xts:::binsearch(dkey, dvec, TRUE)) expect_identical(na, xts:::binsearch(dkey, dvec, FALSE)) # vec is zero-length info_msg <- "test.vec_is_zero_length" # have empty vector return NA ivec <- integer() ikey <- 0L expect_identical(na, xts:::binsearch(ikey, ivec, TRUE)) expect_identical(na, xts:::binsearch(ikey, ivec, FALSE)) dvec <- double() dkey <- 0.0 expect_identical(na, xts:::binsearch(dkey, dvec, TRUE)) expect_identical(na, xts:::binsearch(dkey, dvec, FALSE)) xts/inst/tinytest/test-timeSeries.R0000644000176200001440000001145014540670206017146 0ustar liggesusers## ## Unit Test for timeSeries class from Rmetrics timeSeries package ## ## if (requireNamespace("timeSeries", quietly = TRUE)) { data(sample_matrix) ############################################################################### ############################################################################### # # Multivariate timeSeries tests # ############################################################################### ############################################################################### ############################################################################### # create timeSeries object from sample_matrix sample.timeSeries <- timeSeries::timeSeries(sample_matrix,charvec=as.Date(rownames(sample_matrix))) ############################################################################### ############################################################################### # create corresponding 'xts' object sample.xts <- as.xts(sample.timeSeries) ############################################################################### ############################################################################### # test subsetting functionality of xts info_msg <- "test.convert_timeSeries_to_xts" expect_identical(sample.xts,as.xts(sample.timeSeries), info = info_msg) info_msg <- "test.convert_timeSeries_to_xts_j1" expect_identical(sample.xts[,1],as.xts(sample.timeSeries)[,1], info = info_msg) info_msg <- "test.convert_timeSeries_to_xts_i1" expect_identical(sample.xts[1,],as.xts(sample.timeSeries)[1,], info = info_msg) info_msg <- "test.convert_timeSeries_to_xts_i1j1" expect_identical(sample.xts[1,1],as.xts(sample.timeSeries)[1,1], info = info_msg) # end subsetting functionality ############################################################################### ############################################################################### # test 'reclass' info_msg <- "test.timeSeries_reclass" expect_identical(sample.timeSeries,reclass(try.xts(sample.timeSeries)), info = info_msg) info_msg <- "test.timeSeries_reclass_subset_reclass_j1" expect_identical(sample.timeSeries[,1],reclass(try.xts(sample.timeSeries))[,1], info = info_msg) info_msg <- "test.timeSeries_reclass_subset_as.xts_j1" spl <- sample.timeSeries[,1:2] respl <- reclass(try.xts(sample.timeSeries)[,1:2]) # timeSeries fails to maintain @positions correctly if one column is selected expect_identical(spl,respl, info = info_msg) #expect_identical(1,1, info = info_msg) info_msg <- "test.timeSeries_reclass_subset_timeSeries_j1" spl <- sample.timeSeries[,1:2] respl <- reclass(try.xts(sample.timeSeries[,1:2])) # timeSeries fails to maintain @positions correctly if one column is selected expect_identical(spl,respl, info = info_msg) # expect_identical(1,1, info = info_msg) # end 'reclass' ############################################################################### ############################################################################### ############################################################################### # # Univariate timeSeries tests # ############################################################################### ############################################################################### ############################################################################### # create timeSeries object from sample_matrix sample.timeSeries.univariate <- timeSeries::timeSeries(sample_matrix[,1],charvec=as.Date(rownames(sample_matrix))) ############################################################################### ############################################################################### # create corresponding 'xts' object sample.xts.univariate <- as.xts(sample.timeSeries.univariate) ############################################################################### ############################################################################### # test subsetting functionality of xts info_msg <- "test.convert_timeSeries.univariate_to_xts" expect_identical(sample.xts.univariate,as.xts(sample.timeSeries.univariate), info = info_msg) info_msg <- "test.convert_timeSeries.univariate_to_xts_j1" expect_identical(sample.xts.univariate[,1],as.xts(sample.timeSeries.univariate)[,1], info = info_msg) info_msg <- "test.convert_timeSeries.univariate_to_xts_i1" expect_identical(sample.xts.univariate[1,],as.xts(sample.timeSeries.univariate)[1,], info = info_msg) info_msg <- "test.convert_timeSeries.univariate_to_xts_i1j1" expect_identical(sample.xts.univariate[1,1],as.xts(sample.timeSeries.univariate)[1,1], info = info_msg) # end subsetting functionality ############################################################################### } # requireNamespace xts/inst/api_example/0000755000176200001440000000000014522244665014343 5ustar liggesusersxts/inst/api_example/NAMESPACE0000644000176200001440000000006514522244665015563 0ustar liggesusersimport("xts") useDynLib(linkXTS) export(checkOrder) xts/inst/api_example/README0000644000176200001440000000102514522244665015221 0ustar liggesusersThis directory contains a skeleton example of how to link to the C-API The basic requirements to use the exported xts C code is: (1) Add to your DESCRIPTION file: Depends: xts linkingTo: xts (2) In your .c files: #include "xtsAPI.h" This header file exports the functions that are public in xts. (3) Compile as you would with any other package: R CMD build api_example R CMD INSTALL linkXTS_1.0.tar.gz (4) Try it out! R> require(linkXTS) R> checkOrder(1:10) [1] TRUE R> checkOrder(c(1:10,1)) [1] FALSE xts/inst/api_example/man/0000755000176200001440000000000014522244665015116 5ustar liggesusersxts/inst/api_example/man/checkOrder.Rd0000644000176200001440000000214114522244665017454 0ustar liggesusers\name{checkOrder} \alias{checkOrder} %- Also NEED an '\alias' for EACH other topic documented here. \title{ ~~function to do ... ~~ } \description{ ~~ A concise (1-5 lines) description of what the function does. ~~ } \usage{ checkOrder(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ ~~Describe \code{x} here~~ } } \details{ ~~ If necessary, more details than the description above ~~ } \value{ ~Describe the value returned If it is a LIST, use \item{comp1 }{Description of 'comp1'} \item{comp2 }{Description of 'comp2'} ... } \references{ ~put references to the literature/web site here ~ } \author{ ~~who you are~~ } \note{ ~~further notes~~ ~Make other sections ~ } \seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ } \examples{ ##---- Should be DIRECTLY executable !! ---- ##-- ==> Define data, use random, ##-- or do help(data=index) for the standard data sets. ## The function is currently defined as function(x) { .Call('xtsIs', x) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ misc } xts/inst/api_example/man/linkXTS-package.Rd0000644000176200001440000000204714522244665020335 0ustar liggesusers\name{linkXTS-package} \alias{linkXTS-package} \alias{linkXTS} \docType{package} \title{ What the package does (short line) ~~ package title ~~ } \description{ More about what it does (maybe more than one line) ~~ A concise (1-5 lines) description of the package ~~ } \details{ \tabular{ll}{ Package: \tab linkXTS\cr Type: \tab Package\cr Version: \tab 1.0\cr Date: \tab 2008-11-12\cr License: \tab What license is it under?\cr LazyLoad: \tab yes\cr } ~~ An overview of how to use the package, including the most important ~~ ~~ functions ~~ } \author{ Who wrote it Maintainer: Who to complain to ~~ The author and/or maintainer of the package ~~ } \references{ ~~ Literature or other references for background information ~~ ~~ Optionally other standard keywords, one per line, from file KEYWORDS in ~~ ~~ the R documentation directory ~~ } \keyword{ package } \seealso{ ~~ Optional links to other man pages, e.g. ~~ ~~ \code{\link[:-package]{}} ~~ } \examples{ #~~ simple examples of the most important functions ~~ } xts/inst/api_example/DESCRIPTION0000644000176200001440000000044314522244665016052 0ustar liggesusersPackage: linkXTS Type: Package Title: Tests the interface to xts.so Version: 1.0 Date: 2008-11-12 Depends: xts LinkingTo: xts Author: Jeffrey A. Ryan Maintainer: Jeffrey A. Ryan Description: Demonstrates LinkingTo C code in packages License: GPL (>= 2) LazyLoad: yes xts/inst/api_example/src/0000755000176200001440000000000014522244665015132 5ustar liggesusersxts/inst/api_example/src/checkOrder.c0000644000176200001440000000125314522244665017350 0ustar liggesusers/* Example of using the C API from xts in new package code This is derived from examining the source of packages Matrix and lme4. */ #include #include #include #include /* required by R */ /* The following header file is from the include directory that is included with xts */ #include "xtsAPI.h" /* function declaration and macros */ SEXP check_order (SEXP x, SEXP incr, SEXP strict) { SEXP ret; PROTECT(ret = allocVector(LGLSXP, 1)); /* do_is_ordered is imported from the xts package. All that is needed here is to call it. */ ret = xtsIsOrdered(x, incr, strict); UNPROTECT(1); return ret; } xts/inst/api_example/R/0000755000176200001440000000000014522244665014544 5ustar liggesusersxts/inst/api_example/R/checkOrder.R0000644000176200001440000000015514522244665016741 0ustar liggesusers# R function to call your compiled code checkOrder <- function(x) { .Call('check_order', x, TRUE, TRUE) }