1na.spline <- function(object, ...) UseMethod("na.spline") 2 3na.spline.zoo <- function(object, x = index(object), xout, ..., na.rm = TRUE, maxgap = Inf, along) { 4 5 if (!missing(along)) { 6 warning("along to be deprecated - use x instead") 7 if (missing(x)) x <- along 8 } 9 10 missing.xout <- missing(xout) || is.null(xout) 11 if (is.function(x)) x <- x(index(object)) 12 if (!missing.xout && is.function(xout)) xout <- xout(index(object)) 13 order.by <- if (missing.xout) index(object) else xout 14 xout <- if (missing.xout) x else xout 15 16 if (missing.xout || identical(xout, index(object))) { 17 result <- object 18 } else { 19 object.x <- object 20 if (!identical(class(x), class(xout))) { 21 index(object.x) <- as.numeric(x) 22 xout <- as.numeric(xout) 23 } else { 24 index(object.x) <- x 25 } 26 objectm <- merge(object.x, zoo(, xout)) 27 if (length(dim(objectm)) == 2) colnames(objectm) <- colnames(object) 28 result <- window(objectm, index = xout) 29 } 30 result[] <- na.spline.default(object, x = x, xout = xout, na.rm = FALSE, ..., maxgap = maxgap) 31 if ((!missing(order.by) && !is.null(order.by)) || !missing.xout) { 32 index(result) <- order.by 33 } 34 35 if (na.rm) { 36 result <- na.trim(result, is.na = "all", maxgap = maxgap) 37 } 38 39 result 40 41} 42 43na.spline.zooreg <- function(object, ...) { 44 object. <- structure(object, class = setdiff(class(object), "zooreg")) 45 as.zooreg(na.spline(object., ...)) 46} 47 48 49na.spline.default <- function(object, x = index(object), xout = x, ..., na.rm = TRUE, maxgap = Inf, along) { 50 51 if (!missing(along)) { 52 warning("along to be deprecated - use x instead") 53 if (missing(x)) x <- along 54 } 55 56 na.spline.vec <- function(x, y, xout = x, ...) { 57 na <- is.na(y) 58 if(sum(!na) < 1L) { 59 ## splinefun() cannot be applied here, hence simply: 60 yf <- rep.int(NA, length(xout)) 61 mode(yf) <- mode(y) 62 if(any(!na)) { 63 if(x[!na] %in% xout) { 64 yf[xout == x[!na]] <- y[!na] 65 } 66 } 67 return(yf) 68 } 69 if(all(!na) && (length(xout) > maxgap) && !all(xout %in% x)) { 70 ## for maxgap to work correctly 'y' has to contain 71 ## actual NAs and be expanded to the full x-index 72 xf <- sort(unique(c(x, xout))) 73 yf <- rep.int(NA, length(xf)) 74 yf[MATCH(x, xf)] <- y 75 x <- xf 76 y <- yf 77 } 78 yf <- splinefun(x[!na], y[!na], ...)(xout) 79 if (maxgap < length(y)) { 80 ## construct a series like y but with only gaps > maxgap 81 ## (actual values don't matter as we only use is.na(ygap) below) 82 ygap <- .fill_short_gaps(y, seq_along(y), maxgap = maxgap) 83 ## construct y values at 'xout', keeping NAs from ygap 84 ## (using indexing, as approx() does not allow NAs to be propagated) 85 ix <- splinefun(x, seq_along(y), ...)(xout) 86 yx <- ifelse(is.na(ygap[floor(ix)] + ygap[ceiling(ix)]), NA, yf) 87 yx 88 } else { 89 yf 90 } 91 } 92 93 if (!identical(length(x), length(index(object)))) { 94 stop("x and index must have the same length") 95 } 96 x. <- as.numeric(x) 97 if (missing(xout) || is.null(xout)) xout <- x. 98 xout. <- as.numeric(xout) 99 object. <- coredata(object) 100 101 result <- if (length(dim(object.)) < 2) { 102 na.spline.vec(x., coredata(object.), xout = xout., ...) 103 } else { 104 apply(coredata(object.), 2, na.spline.vec, x = x., xout = xout., ...) 105 } 106 107 if (na.rm) { 108 result <- na.trim(result, is.na = "all", maxgap = maxgap) 109 } 110 111 result 112 113} 114 115na.spline.ts <- function(object, ...) { 116 as.ts(na.spline(as.zoo(object), ...)) 117} 118 119