Декомпозиция () использует filter(), исходный код вызывает функцию C?

Я выполняю декомпозицию в R, и она возвращает компонент тренда, и я пытаюсь понять, где он получил тренд, потому что, похоже, он усекает начало и конец, и, если я правильно понимаю, это скользящее среднее. Тем не менее, чтение документации и исходного кода не дает мне никакой подсказки, я прошел его шаг за шагом и застрял в filter(), поэтому я прочитал этот исходный код, но он помещает кучу параметров в функцию C, которую я не понимаю! Может ли кто-нибудь помочь мне? В конце концов я хочу переписать функцию на другом языке (SAS), поэтому мне нужно понять, как она работает.

Функция для фильтра ниже.

function (x, filter, method = c("convolution", "recursive"), 
    sides = 2L, circular = FALSE, init = NULL) 
{
    method <- match.arg(method)
    x <- as.ts(x)
    storage.mode(x) <- "double"
    xtsp <- tsp(x)
    n <- as.integer(NROW(x))
    if (is.na(n)) 
        stop(gettextf("invalid value of %s", "NROW(x)"), domain = NA)
    nser <- NCOL(x)
    filter <- as.double(filter)
    nfilt <- as.integer(length(filter))
    if (is.na(nfilt)) 
        stop(gettextf("invalid value of %s", "length(filter)"), 
            domain = NA)
    if (anyNA(filter)) 
        stop("missing values in 'filter'")
    if (method == "convolution") {
        if (nfilt > n) 
            stop("'filter' is longer than time series")
        sides <- as.integer(sides)
        if (is.na(sides) || (sides != 1L && sides != 2L)) 
            stop("argument 'sides' must be 1 or 2")
        circular <- as.logical(circular)
        if (is.na(circular)) 
            stop("'circular' must be logical and not NA")
        if (is.matrix(x)) {
            y <- matrix(NA, n, nser)
            for (i in seq_len(nser)) y[, i] <- .Call(C_cfilter, 
                x[, i], filter, sides, circular)
        }
        else y <- .Call(C_cfilter, x, filter, sides, circular)
    }
    else {
        if (missing(init)) {
            init <- matrix(0, nfilt, nser)
        }
        else {
            ni <- NROW(init)
            if (ni != nfilt) 
                stop("length of 'init' must equal length of 'filter'")
            if (NCOL(init) != 1L && NCOL(init) != nser) {
                stop(sprintf(ngettext(nser, "'init' must have %d column", 
                  "'init' must have 1 or %d columns", domain = "R-stats"), 
                  nser), domain = NA)
            }
            if (!is.matrix(init)) 
                dim(init) <- c(nfilt, nser)
        }
        ind <- seq_len(nfilt)
        if (is.matrix(x)) {
            y <- matrix(NA, n, nser)
            for (i in seq_len(nser)) y[, i] <- .Call(C_rfilter, 
                x[, i], filter, c(rev(init[, i]), double(n)))[-ind]
        }
        else y <- .Call(C_rfilter, x, filter, c(rev(init[, 1L]), 
            double(n)))[-ind]
    }
    tsp(y) <- xtsp
    class(y) <- if (nser > 1L) 
        c("mts", "ts")
    else "ts"
    y
}

0 ответов

Другие вопросы по тегам