1#  File src/library/stats/R/na.ts.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2012 The R Core Team
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  A copy of the GNU General Public License is available at
17#  https://www.R-project.org/Licenses/
18
19na.contiguous <- function(object, ...) UseMethod("na.contiguous")
20
21na.contiguous.default <- function(object, ...)
22{
23    tm <- time(object)
24    xfreq <- frequency(object)
25    ## use (first) maximal contiguous length of non-NAs
26    if(is.matrix(object))
27        good <- apply(!is.na(object), 1L, all)
28    else  good <- !is.na(object)
29    if(!sum(good)) stop("all times contain an NA")
30    tt <- cumsum(!good)
31    ln <- sapply(0:max(tt), function(i) sum(tt==i))
32    seg <- (seq_along(ln)[ln==max(ln)])[1L] - 1
33    keep <- (tt == seg)
34    st <- min(which(keep))
35    if(!good[st]) st <- st + 1
36    en <- max(which(keep))
37    omit <- integer()
38    n <- NROW(object)
39    if(st > 1) omit <- c(omit, 1L:(st-1))
40    if(en < n) omit <- c(omit, (en+1):n)
41    cl <- class(object)
42    if(length(omit)) {
43        object <- if(is.matrix(object)) object[st:en,] else object[st:en]
44        attr(omit, "class") <- "omit"
45        attr(object, "na.action") <- omit
46        tsp(object) <- c(tm[st], tm[en], xfreq)
47        if(!is.null(cl)) class(object) <- cl
48    }
49    object
50}
51