R/api_patterns.R

Defines functions .pattern_labels .pattern_temporal_median

#' @title Extract temporal pattern from samples data.
#' @name .pattern_temporal_median
#' @keywords internal
#' @noRd
#' @param    samples Samples data.
.pattern_temporal_median <- function(samples) {
    samples |>
        dplyr::group_by(.data[["label"]]) |>
        dplyr::group_map(function(data, name) {
            ts_median <- dplyr::bind_rows(data[["time_series"]]) |>
                dplyr::group_by(.data[["Index"]]) |>
                dplyr::summarize(dplyr::across(dplyr::everything(),
                                               stats::median, na.rm = TRUE)) |>
                dplyr::select(-.data[["Index"]])

            ts_median["label"] <- name
            ts_median
        })
}

#' @title Extract labels available in patterns.
#' @name .pattern_labels
#' @keywords internal
#' @noRd
#' @param  patterns Samples patterns.
.pattern_labels <- function(patterns) {
    purrr::map_vec(patterns, function(pattern) {
        unique(pattern[["label"]])
    })
}

Try the sits package in your browser

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

sits documentation built on Sept. 11, 2024, 6:36 p.m.