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