add support for base data with multiple timesteps

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)

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

R/api_samples.R

@@ -89,51 +89,64 @@
 #' @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) {
     # Bands of the first sample governs whole samples data
     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
 #' @return Timeline of the first sample
 .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

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