[Rd] head.ts, tail.ts loses time

[Spencer Graves]

Hi, Gabor et al.:


	  Thanks for this. I should change my current application to use either 
zoo or xts, as Gabor suggests.


	  However, I was surprised to learn that "[.ts" does NOT return an 
object of class "ts". I see that "head.default" and "head.matrix" both 
call "[", so "head" cannot return a ts object, because "[" doesn't.


	  Best Wishes,
	  Spencer Graves


On 6/9/24 8:40 PM, Gabor Grothendieck wrote:
> zoo overcomes many of the limitations of ts:
> 
>    library(zoo)
>    as.ts(head(as.zoo(presidents)))
>    ##      Qtr1 Qtr2 Qtr3 Qtr4
>    ## 1945   NA   87   82   75
>    ## 1946   63   50
> 
> xts also works here.
> 
> On Sun, Jun 9, 2024 at 12:04 PM Spencer Graves
> <spencer.graves using prodsyse.com> wrote:
>>
>> Hello, All:
>>
>>
>>            The 'head' and 'tail' functions strip the time from a 'ts' object.
>> Example:
>>
>>
>>   > head(presidents)
>> [1] NA 87 82 75 63 50
>>
>>
>>   > window(presidents, 1945, 1946.25)
>>        Qtr1 Qtr2 Qtr3 Qtr4
>> 1945   NA   87   82   75
>> 1946   63   50
>>
>>
>>            Below please find code for 'head.ts' and 'tail.ts' that matches
>> 'window'.
>>
>>
>>            Comments?
>>            Spencer Graves
>>
>> head.ts <- function(x, n=6L, ...){
>>     tmx <- as.numeric(time(x))
>> #
>>     utils:::checkHT(n, d <- dim(x))
>>     if(is.na(n[1]) || n[1]==0)ts(NULL)
>> #
>>     firstn <- head(tmx, n[1])
>>     if(is.null(d)){
>>       return(window(x, firstn[1], tail(firstn, 1)))
>>     } else{
>>       if(length(n)<2){
>>         return(window(x, firstn[1], tail(firstn, 1)))
>>       } else {
>>         Cols <- head(1:d[2], n[2])
>>         xn2 <- x[, Cols[1]:tail(Cols, 1)]
>>         return(window(xn2, firstn[1], tail(firstn, 1)))
>>       }
>>     }
>> }
>>
>>
>> tail.ts <- function (x, n = 6L, ...)
>> {
>>     utils:::checkHT(n, d <- dim(x))
>>     tmx <- as.numeric(time(x))
>> #
>>     if(is.na(n[1]) || n[1]==0)ts(NULL)
>> #
>>     lastn <- tail(tmx, n[1])
>>     if(is.null(d)){
>>       return(window(x, lastn[1], tail(lastn, 1)))
>>     } else{
>>       if(length(n)<2){
>>         return(window(x, lastn[1], tail(lastn, 1)))
>>       } else {
>>         Cols <- head(1:d[2], n[2])
>>         xn2 <- x[, Cols[1]:tail(Cols, 1)]
>>         return(window(xn2, lastn[1], tail(lastn, 1)))
>>       }
>>     }
>> }
>>
>>
>> # examples
>> head(presidents)
>>
>> head(presidents, 2)
>>
>> npresObs <- length(presidents)
>> head(presidents, 6-npresObs)
>>
>> try(head(presidents, 1:2)) # 'try-error'
>>
>> try(head(presidents, 0)) # 'try-error'
>>
>> # matrix time series
>> str(pres <- cbind(n=1:length(presidents), presidents))
>> head(pres, 2)
>>
>> head(pres, 2-npresObs)
>>
>> head(pres, 1:2)
>> head(pres, 2:1)
>> head(pres, 1:3)
>>
>> # examples
>> tail(presidents)
>>
>> tail(presidents, 2)
>>
>> npresObs <- length(presidents)
>> tail(presidents, 6-npresObs)
>>
>> try(tail(presidents, 1:2)) # 'try-error'
>>
>> try(tail(presidents, 0)) # 'try-error'
>>
>> # matrix time series
>> str(pres <- cbind(n=1:length(presidents), presidents))
>> tail(pres, 2)
>>
>> tail(pres, 2-npresObs)
>>
>> tail(pres, 1:2)
>> tail(pres, 2:1)
>> tail(pres, 1:3)
>>
>> # for unit testing:
>> headPres <- head(presidents)
>> pres6 <- ts(presidents[1:6], time(presidents)[1],
>>               frequency=frequency(presidents))
>> stopifnot(all.equal(headPres, pres6))
>>
>> headPres2 <- head(presidents, 2)
>> pres2 <- ts(presidents[1:2], time(presidents)[1],
>>               frequency=frequency(presidents))
>> stopifnot(all.equal(headPres2, pres2))
>>
>> npresObs <- length(presidents)
>> headPres. <- head(presidents, 6-npresObs)
>> stopifnot(all.equal(headPres., pres6))
>>
>> headPresOops <- try(head(presidents, 1:2))
>> stopifnot(class(headPresOops) == 'try-error')
>>
>> headPres0 <- try(head(presidents, 0))
>> stopifnot(class(headPres0) == 'try-error')
>>
>> str(pres <- cbind(n=1:length(presidents), presidents))
>> headP2 <- head(pres, 2)
>>
>> p2 <- ts(pres[1:2, ], time(presidents)[1],
>>            frequency=frequency(presidents))
>> stopifnot(all.equal(headP2, p2))
>>
>> headP2. <- head(pres, 2-npresObs)
>> stopifnot(all.equal(headP2., p2))
>>
>>
>> #############
>>
>>
>> sessionInfo()
>> R version 4.4.0 (2024-04-24)
>> Platform: aarch64-apple-darwin20
>> Running under: macOS Sonoma 14.5
>>
>> Matrix products: default
>> BLAS:
>> /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
>>
>> LAPACK:
>> /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib;
>>    LAPACK version 3.12.0
>>
>> locale:
>> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
>>
>> time zone: America/Chicago
>> tzcode source: internal
>>
>> attached base packages:
>> [1] stats     graphics  grDevices utils     datasets
>> [6] methods   base
>>
>> loaded via a namespace (and not attached):
>> [1] compiler_4.4.0 tools_4.4.0
>>
>> ______________________________________________
>> R-devel using r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
> 
> 
>