R/sits_ts.R

In e-sensing/sits.data: Satellite Image Time Series Data Handling

#' @title Export data to be used to the ts format
#' @name sits_to_ts
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#'
#' @description Converts data from a wtss tibble to a time series "ts".
#' SITS tibbles are time series with irregular intervals. Given that
#' of many functions that use the R "ts" format, this function converts
#' a SITS time series (a tibble with data and metadata) to the "ts" format.
#' Since  "ts" requires regular time series, it interpolates
#' the original irregular time series to a regular time series. To do this, the
#' user needs to specify a period which is recognised by the "ts" format.
#' This period can be either {"year", "quarter", "month", "week", "day"},
#' {"years", "quarters", "months", "weeks", "days"} or
#' {1, 4, 12, 52}. This function creates a new time series with the required
#' frequency and intepolates the missing values using spline interpolation
#' from the "zoo" package (zoo::na.spline).
#'
#' @param  data          A sits tibble with time series.
#' @param  band          Name of the band to be exported
#'                       (optional if series has only one band)
#' @param  period        One of c("year", "quarter", "month", "week", "day"),
#'                       c("years", "quarters", "months", "weeks", "days") or
#'                       c(1, 4, 12, 52)
#' @return               A time series in the ts format.
#' @examples {
#' # convert to TS
#' ts <- sits_to_ts(cerrado_2classes[1,], band = "ndvi")
#' }
#' @export
sits_to_ts <- function(data, band  = NULL, period = "week"){
    # only convert one row at a time
    assertthat::assert_that(nrow(data) == 1,
                            msg = "WTSS - Convertion to ts only accepts
                    one time series at a time.")

    # retrieve the time series
    ts_wtss <- tibble::as_tibble(data$time_series[[1]])
    # no band informed?
    if (purrr::is_null(band)) {
        # only univariate time series are accepted
        assertthat::assert_that(ncol(ts_wtss) == 2,
                                msg = "WTSS - Convertion to ts only accepts
                                one band at a time.")
        band <- names(ts_wtss[,2])
    }
    # check valid periods
    valid_periods_1 <- c("year", "quarter", "month", "week", "day")
    valid_periods_2 <- c("years", "quarters", "months", "weeks", "days")
    valid_frequencies <- c(1, 4, 12, 52, 365)
    names(valid_frequencies) <- c("year", "quarter", "month", "week", "day")
    names(valid_periods_2)   <- c("year", "quarter", "month", "week", "day")

    assertthat::assert_that(period %in% valid_periods_1 ||
                                period %in% valid_periods_2 ||
                                period %in% valid_frequencies,
                            msg = "WTSS - Invalid period for convertion to ts")
    # is the period in c("year", "quarter", "month", "day")?
    if (period %in% valid_periods_1) {
        zoo_frequency <- period
        ts_frequency  <- valid_frequencies[period]
    }
    # is the period in c("years", "quarters", "months", "days")?
    else if (period %in% valid_periods_2) {
        zoo_frequency <- names(valid_periods_2[period])
        ts_frequency  <- valid_frequencies[zoo_frequency]
    }
    # is the period in c(1, 4, 12, 52)?
    else if (period %in% valid_frequencies) {
        zoo_frequency <- names(valid_frequencies[period])
        ts_frequency  <- period
    }
    else {
        message("WTSS - Invalid period ")
        return(NULL)
    }

    # get the start and end date of the series
    start_date <- lubridate::as_date(data$start_date)
    end_date   <- lubridate::as_date(data$end_date)

    # convert to zoo
    ts_zoo <-  wtss::wtss_to_zoo(data)

    # create a regular zoo time series
    # create a timeline with regular interval
    timeline_reg <- seq(start_date, end_date, by = zoo_frequency)
    # create a zoo time series with regular intervals filled with NA
    ts_zoo_reg <- zoo::zoo(x = NA, order.by = timeline_reg)

    # merge the two time series (regular and irregular)
    ts_zoo_merged <- zoo::merge.zoo(ts_zoo, ts_zoo_reg)[,band]

    # interpolated zoo series
    ts_zoo_interp <- zoo::na.spline(ts_zoo_merged)
    #get regular time series
    ts_zoo_reg2 <- ts_zoo_interp[zoo::index(ts_zoo_reg)]

    ts_start <- c(as.numeric(lubridate::year(start_date)),
                  as.numeric(lubridate::week(start_date)))
    ts_end   <- c(as.numeric(lubridate::year(end_date)),
                  as.numeric(lubridate::week(end_date)))

    ts_ts <- stats::ts(data = ts_zoo_reg2, start = ts_start, end = ts_end,
                       frequency = ts_frequency)

    return(ts_ts)
}