thr3ads.net - R devel - [Rd] head.ts, tail.ts loses time [Jun 2024]

If this information is useful, please help other people find it:
Share via:

Spencer Graves

2024-Jun-09 16:03 UTC

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

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

Josiah Parry

2024-Jun-09 16:20 UTC

head link

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

It looks like to me the class is being removed explicitly due to the use of
as.numeric()

On Sun, Jun 9, 2024 at 12:04?PM Spencer Graves <spencer.graves at
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 at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
	[[alternative HTML version deleted]]

Gabor Grothendieck

2024-Jun-10 01:40 UTC

head link

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

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 at 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 at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel


-- 
Statistics & Software Consulting
GKX Group, GKX Associates Inc.
tel: 1-877-GKX-GROUP
email: ggrothendieck at gmail.com

Reasonably Related Threads

Search for more reasonably related threads

R devel - Jun 2024 - head.ts, tail.ts loses time

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

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

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

Reasonably Related Threads