R/sits_imputation.R

Defines functions sits_impute impute_linear impute_linear

Documented in impute_linear sits_impute

#' @title Replace NA values with linear interpolation
#' @name impute_linear
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description Remove NA by linear interpolation
#'
#' @param  data          A time series vector or matrix
#' @return               A set of filtered time series using
#'                       the imputation function.
#'
#' @export
impute_linear <- function(data = NULL) {
    impute_fun <- function(data) {
        if (inherits(data, "matrix")) {
            return(linear_interp(data))
        } else {
            return(linear_interp_vec(data))
        }
    }

    result <- .factory_function(data, impute_fun)

    return(result)
}
#' @title Replace NA values with linear interpolation
#' @name impute_linear
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description Remove NA by linear interpolation
#'
#' @param  data          A time series vector or matrix
#' @return               A set of filtered time series using
#'                       the imputation function.
#'
#' @export
impute_linear <- function(data = NULL) {
    impute_fun <- function(data) {
        if (inherits(data, "matrix")) {
            return(linear_interp(data))
        } else {
            return(linear_interp_vec(data))
        }
    }

    result <- .factory_function(data, impute_fun)

    return(result)
}
#' @title Replace NA values in time series with imputation function
#' @name sits_impute
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#' @description Remove NA
#'
#' @param  samples        A time series tibble
#' @param  impute_fn     Imputation function
#' @return               A set of filtered time series using
#'                       the imputation function.
#'
#' @export
sits_impute <- function(samples, impute_fn = impute_linear()) {
    # check data is time series
    .check_samples(samples)
    # extract time series
    data <- .ts(samples)
    impute_fun <- function(data) {
        if (inherits(data, "matrix")) {
            return(linear_interp(data))
        } else {
            return(linear_interp_vec(data))
        }
    }

    result <- .factory_function(data, impute_fun)

    return(result)
}

Try the sits package in your browser

Any scripts or data that you put into this service are public.

sits documentation built on May 29, 2024, 5:55 a.m.