From 7e479c1cbca9b1768315fee8a303512847e2ee1d Mon Sep 17 00:00:00 2001 From: Felipe Carlos Date: Tue, 2 Jul 2024 15:58:26 -0300 Subject: [PATCH] add support for base data with multiple timesteps --- R/api_check.R | 2 +- R/api_predictors.R | 25 ++++++++++++------------ R/api_samples.R | 43 +++++++++++++++++++++++++++--------------- R/sits_add_base_cube.R | 5 ++++- 4 files changed, 45 insertions(+), 30 deletions(-) diff --git a/R/api_check.R b/R/api_check.R index 79a6105c8..230109e2f 100644 --- a/R/api_check.R +++ b/R/api_check.R @@ -1766,7 +1766,7 @@ n_bands <- length(.samples_bands.sits(samples)) n_times <- length(.samples_timeline(samples)) if(inherits(samples, "sits_base")) - n_bands_base <- length(.samples_bands_base(samples)) + n_bands_base <- length(.samples_base_bands(samples)) else n_bands_base <- 0 .check_that(ncol(pred) == 2 + n_bands * n_times + n_bands_base) diff --git a/R/api_predictors.R b/R/api_predictors.R index 5ac6fc596..779028b2f 100644 --- a/R/api_predictors.R +++ b/R/api_predictors.R @@ -19,15 +19,12 @@ # Get samples time series pred <- .ts(samples) # By default get bands as the same of first sample - bands <- .samples_bands(samples) - # Remove base bands in samples - if (.samples_is_base(samples)) { - bands <- setdiff(bands, .samples_bands_base(samples)) - } + bands <- .samples_bands(samples, include_base = FALSE) # Preprocess time series if (.has(ml_model)) { # If a model is informed, get predictors from model bands - bands <- .ml_bands(ml_model) + bands <- intersect(.ml_bands(ml_model), bands) + # Normalize values for old version model classifiers that # do not normalize values itself # Models trained after version 1.2 do this automatically before @@ -76,15 +73,18 @@ samples <- .samples_prune(samples) # Get samples time series pred <- .predictors.sits(samples, ml_model) - # get predictors for base data - base <- dplyr::bind_rows(samples[["base_data"]]) - base <- base[,-1] - # join time series predictors with base data predictors - pred <- dplyr::bind_cols(pred, base) + # Get predictors for base data + pred_base <- samples |> + dplyr::rename( + "_" = "time_series", "time_series" = "base_data" + ) |> + .predictors.sits() |> + dplyr::select(-.data[["label"]]) + # Merge predictors + pred <- dplyr::inner_join(pred, pred_base, by = "sample_id") # Return predictors pred } - #' @title Get predictors names with timeline #' @keywords internal #' @noRd @@ -100,7 +100,6 @@ USE.NAMES = FALSE )) } - #' @title Get features from predictors #' @keywords internal #' @noRd diff --git a/R/api_samples.R b/R/api_samples.R index f7ee639f5..232a157a2 100644 --- a/R/api_samples.R +++ b/R/api_samples.R @@ -89,23 +89,28 @@ #' @noRd #' @param samples Data.frame with samples #' @return Bands for the first sample -.samples_bands <- function(samples) { +.samples_bands <- function(samples, ...) { # Bands of the first sample governs whole samples data UseMethod(".samples_bands", samples) } #' @export -.samples_bands.sits <- function(samples) { +.samples_bands.sits <- function(samples, ...) { # Bands of the first sample governs whole samples data bands <- setdiff(names(.samples_ts(samples)), "Index") return(bands) } #' @export -.samples_bands.sits_base <- function(samples) { +.samples_bands.sits_base <- function(samples, include_base = TRUE) { # Bands of the first sample governs whole samples data - ts_bands <- .samples_bands.sits(samples) - base_bands <- .samples_bands_base(samples) - bands <- c(ts_bands, base_bands) - return(bands) + bands <- .samples_bands.sits(samples) + + if (include_base) { + bands <- c( + bands, .samples_base_bands(samples) + ) + } + + bands } #' @export .samples_bands.default <- function(samples) { @@ -113,19 +118,28 @@ ts_bands <- .samples_bands.sits(samples) return(ts_bands) } +#' @title Check if samples is base (has base property) +#' @noRd +#' @param samples Data.frame with samples +#' @return TRUE/FALSE +.samples_is_base <- function(samples) { + inherits(samples, "sits_base") +} +#' @title Get samples base data (if available) +#' @noRd +#' @param samples Data.frame with samples +#' @return data.frame with base data. +.samples_base_data <- function(samples) { + samples[["base_data"]] +} #' @title Get bands of base data for samples #' @noRd #' @param samples Data.frame with samples #' @return Bands for the first sample -.samples_bands_base <- function(samples) { +.samples_base_bands <- function(samples) { # Bands of the first sample governs whole samples data - setdiff(names(samples$base_data[[1]]), "Index") + setdiff(names(samples[["base_data"]][[1]]), "Index") } - -.samples_is_base <- function(samples) { - inherits(samples, "sits_base") -} - #' @title Get timeline of time series samples #' @noRd #' @param samples Data.frame with samples @@ -133,7 +147,6 @@ .samples_timeline <- function(samples) { as.Date(samples[["time_series"]][[1]][["Index"]]) } - #' @title Select bands of time series samples #' @noRd #' @param samples Data.frame with samples diff --git a/R/sits_add_base_cube.R b/R/sits_add_base_cube.R index 056dcacec..7e294fd9c 100644 --- a/R/sits_add_base_cube.R +++ b/R/sits_add_base_cube.R @@ -70,8 +70,11 @@ sits_add_base_cube <- function(cube1, cube2) { tile_cube2 <- .cube_filter_tiles(cube2, tile_name) # get files from 2nd cube fi_cube2 <- .fi(tile_cube2) + # get timelines + tile_cube1_tl <- .tile_timeline(tile_cube1) + tile_cube2_tl <- .tile_timeline(tile_cube2) # align timelines - fi_cube2[["date"]] <- .fi_min_date(.fi(tile_cube1)) + fi_cube2[["date"]] <- tile_cube1_tl[1:length(tile_cube2_tl)] # update 2nd cube files .fi(tile_cube2) <- fi_cube2 # append cube to base info