diff --git a/ChangeLog b/ChangeLog index 9246ceb3..e36dd121 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,6 @@ Version 7.4 (?? 2016) * Added gghistogram() and checkresiduals() + * Added head.ts() and tail.ts(), so head and tail now work properly on ts objects. * Bug fixes Version 7.3 (12 October 2016) diff --git a/NAMESPACE b/NAMESPACE index 5af89ad6..5213d922 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,10 +20,9 @@ importFrom("stats", "Box.test", "acf", "approx", "ar", "arima", "qnorm", "qt", "quantile", "residuals", "rnorm", "runif", "sd", "simulate", "smooth.spline", "start", "stl", "supsmu", "terms", "time", "ts", "tsp", "tsp<-", "tsdiag", "var") -importFrom("utils", "packageVersion", "tail") +importFrom("utils", "packageVersion", "tail", "head") importFrom("ggplot2","autoplot","fortify") importFrom("stats", "aggregate", "as.formula", "is.mts", "reformulate") -importFrom("utils", "head") export(arfima, Arima, arima.errors, arimaorder, auto.arima, BoxCox, croston, fitted.Arima, forecast, forecast.ar, forecast.Arima, forecast.ets, forecast.fracdiff,findfrequency, @@ -87,6 +86,8 @@ S3method(getResponse,Arima) S3method(getResponse,default) S3method(getResponse,fracdiff) S3method(getResponse,lm) +S3method(head,ts) +S3method(tail,ts) S3method(logLik,ets) S3method(plot,ar) S3method(plot,Arima) diff --git a/R/subset.R b/R/subset.R index a4d6966b..e8d0b055 100644 --- a/R/subset.R +++ b/R/subset.R @@ -48,7 +48,7 @@ subset.ts <- function(x, subset=NULL, month=NULL, quarter=NULL, season=NULL, ... else if(min(season) < 1L | max(season) > frequency(x)) stop(paste("Seasons must be between 1 and", frequency(x))) - + start <- utils::head(time(x)[is.element(cycle(x), season)],1) if("mts" %in% class(x)){ x <- subset.matrix(x, is.element(cycle(x), season)) @@ -58,3 +58,28 @@ subset.ts <- function(x, subset=NULL, month=NULL, quarter=NULL, season=NULL, ... } return(ts(x, frequency=length(season), start=start)) } + +head.ts <- function(x, n=6L, ...) +{ + tspx <- tsp(x) + if(NCOL(x) > 1) + hx <- ts(utils::head.matrix(as.matrix(x), n=n, ...), + start=tspx[1], frequency=tspx[3]) + else + hx <- ts(head(c(x), n=n, ...), + start=tspx[1], frequency=tspx[3]) + return(hx) +} + + +tail.ts <- function(x, n=6L, ...) +{ + tspx <- tsp(x) + if(NCOL(x) > 1) + hx <- ts(utils::tail.matrix(as.matrix(x), n=n, ...), + end=tspx[2], frequency=tspx[3]) + else + hx <- ts(tail(c(x), n=n, ...), + end=tspx[2], frequency=tspx[3]) + return(hx) +}