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