yet another ts problem

[Martyn Plummer]

Paul Gilbert wrote:

> Splus 3.3 has  "[.its", "[.cts", and "[.rts", the class methods for time series.
> However, I haven't used them much and I have no idea if they work properly.

Splus time series do preserve their class: an irregular subset of an rts
(regular)
or its (irregular) yields an its, and a regular subset of either yields an rts.
Since time series are classed objects in R, they are more like Splus "rts"
objects than vanilla S time series: hence the idea that subsetting should
preserve
the class (yes I am responsible for this, and I'm REALLY sorry about the
warning).

> Martyn Plummer wrote:
> 
> >An alternative to using "[.ts" to take row subsets would be to
> >expand the window.ts() function to include a "freq" or "deltat"
> >argument.
> 
> I don't see why this should be necessary? window works with dates and
> automatically knows the frequency of the object.

Perhaps I wasn't very clear. There are three ways to take a subset
of a regular time series that yield another regular time series:
1) Take all observations after "start"
2) Take all observations before "end"
3) Take all observations where time between "start" and the observation
   is a multiple of "deltat".
We all agree that "[.ts" isn't the place to do this.  Since window.ts
already does 1) and 2), I propose extending it to do 3) too. Maybe
this is silly. Maybe nobody else wants to do this. But anyway, the
code is below. YMMV.

Martyn

"window.ts" <-
function (x, start, end, frequency, deltat) 
{
    x <- as.ts(x)
    xtsp <- tsp(x)
    xfreq <- xtsp[3]
    xtime <- time(x)
    ts.eps <- .Options$ts.eps
    if (missing(frequency) && missing(deltat)) 
        yfreq <- xfreq
    else if (missing(deltat)) 
        yfreq <- frequency
    else if (missing(frequency)) 
        yfreq <- 1/deltat
    if (xfreq%%yfreq < ts.eps) {
        thin <- round(xfreq/yfreq)
        yfreq <- xfreq/thin
    }
    else {
        thin <- 1
        yfreq <- xfreq
        warning("Frequency not changed")
    }
    start <- if (missing(start)) 
        xtsp[1]
    else switch(length(start), start, start[1] + (start[2] - 
        1)/xfreq, stop("Bad value for start"))
    if (start < xtsp[1]) {
        start <- xtsp[1]
        warning("start value not changed")
    }
    end <- if (missing(end)) 
        xtsp[2]
    else switch(length(end), end, end[1] + (end[2] - 1)/xfreq, 
        stop("Bad value for end"))
    if (end > xtsp[2]) {
        end <- xtsp[2]
        warning("end value not changed")
    }
    if (start > end) 
        stop("start cannot be after end")
    if (all(abs(start - xtime) > abs(start) * ts.eps)) {
        start <- xtime[(xtime > start) & ((start + 1/xfreq) > 
            xtime)]
    }
    if (all(abs(end - xtime) > abs(end) * ts.eps)) {
        end <- xtime[(xtime < end) & ((end - 1/xfreq) < xtime)]
    }
    i <- seq(trunc((start - xtsp[1]) * xfreq + 1.5), trunc((end - 
        xtsp[1]) * xfreq + 1.5), by = thin)
    y <- if (is.matrix(x)) 
        x[i, , drop = FALSE]
    else x[i]
    ystart <- xtime[i[1]]
    yend <- xtime[i[length(i)]]
    tsp(y) <- c(ystart, yend, yfreq)
    y
}

function (x, i, j, drop = TRUE) 
{
    y <- NextMethod("[")
    if (missing(i)) 
        ts(y, start = start(x), freq = frequency(x))
    else y
}
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._