[Rd] head.ts, tail.ts loses time
Spencer Graves
@pencer@gr@ve@ @end|ng |rom prod@y@e@com
Sun Jun 9 18:03:52 CEST 2024
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
More information about the R-devel
mailing list