build rfor model with base bands

Author: gilbertocamara

NAMESPACE

@@ -98,6 +98,8 @@ S3method(.opensearch_cdse_extract_tile,RTC)
 S3method(.opensearch_cdse_extract_tile,S2MSI2A)
 S3method(.opensearch_cdse_search,RTC)
 S3method(.opensearch_cdse_search,S2MSI2A)
+S3method(.predictors,sits)
+S3method(.predictors,sits_base)
 S3method(.raster_check_package,terra)
 S3method(.raster_col,terra)
 S3method(.raster_crop,terra)
@@ -132,6 +134,8 @@ S3method(.reg_s2tile_convert,grd_cube)
 S3method(.reg_s2tile_convert,rtc_cube)
 S3method(.samples_alloc_strata,class_cube)
 S3method(.samples_alloc_strata,class_vector_cube)
+S3method(.samples_bands,sits)
+S3method(.samples_bands,sits_base)
 S3method(.slice_dfr,numeric)
 S3method(.source_collection_access_test,"mpc_cube_sentinel-1-grd")
 S3method(.source_collection_access_test,cdse_cube)

R/api_band.R

@@ -15,7 +15,7 @@
 #' @return Updated sits object
 #' @export
 .band_rename.sits <- function(x, bands) {
-    data_bands <- .samples_bands(x)
+    data_bands <- .samples_bands.sits(x)
     # pre-condition
     .check_chr(
         bands,

R/api_check.R

@@ -1763,9 +1763,13 @@
     cols <- .pred_cols # From predictors API
     .check_that(cols %in% colnames(pred))
     .check_that(nrow(pred) > 0)
-    n_bands <- length(.samples_bands(samples))
+    n_bands <- length(.samples_bands.sits(samples))
     n_times <- length(.samples_timeline(samples))
-    .check_that(ncol(pred) == 2 + n_bands * n_times)
+    if(inherits(samples, "sits_base"))
+        n_bands_base <- length(.samples_bands_base(samples))
+    else
+        n_bands_base <- 0
+    .check_that(ncol(pred) == 2 + n_bands * n_times + n_bands_base)
     return(invisible(pred))
 }
 #' @title Does the data contain the cols of sample data and is not empty?

R/api_predictors.R

@@ -9,6 +9,11 @@
 #' @param  ml_model ML model (optional)
 #' @return          Data.frame with predictors
 .predictors <- function(samples, ml_model = NULL) {
+    UseMethod(".predictors", samples)
+}
+#'
+#' @export
+.predictors.sits <- function(samples, ml_model = NULL) {
     # Prune samples time series
     samples <- .samples_prune(samples)
     # Get samples time series
@@ -61,6 +66,37 @@
     # Return predictors
     pred
 }
+#' @export
+.predictors.sits_base <- function(samples, ml_model = NULL) {
+    # Get predictors for time series
+    # Prune samples time series
+    samples <- .samples_prune(samples)
+    # Get samples time series
+    pred <- .ts(samples)
+    # By default get bands as the same of first sample
+    bands <- .samples_bands.sits(samples)
+    # Create predictors...
+    pred <- pred[c(.pred_cols, bands)]
+    # Add sequence 'index' column grouped by 'sample_id'
+    pred <- pred |>
+        dplyr::select("sample_id", "label", dplyr::all_of(bands)) |>
+        dplyr::group_by(.data[["sample_id"]]) |>
+        dplyr::mutate(index = seq_len(dplyr::n())) |>
+        dplyr::ungroup()
+    # Rearrange data to create predictors
+    pred <- tidyr::pivot_wider(
+        data = pred, names_from = "index", values_from = dplyr::all_of(bands),
+        names_prefix = if (length(bands) == 1) bands else "",
+        names_sep = ""
+    )
+    # 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)
+    # Return predictors
+    pred
+}
 
 #' @title Get predictors names with timeline
 #' @keywords internal

R/api_samples.R

@@ -90,9 +90,29 @@
 #' @param samples Data.frame with samples
 #' @return Bands for the first sample
 .samples_bands <- function(samples) {
+    # Bands of the first sample governs whole samples data
+    UseMethod(".samples_bands", samples)
+}
+#' @export
+.samples_bands.sits <- function(samples) {
     # Bands of the first sample governs whole samples data
     setdiff(names(.samples_ts(samples)), "Index")
 }
+#' @export
+.samples_bands.sits_base <- function(samples) {
+    # 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)
+}
+#' @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) {
+    # Bands of the first sample governs whole samples data
+    setdiff(names(samples$base_data[[1]]), "Index")
+}
 
 #' @title Get timeline of time series samples
 #' @noRd

R/api_tile.R

@@ -532,12 +532,26 @@ NULL
     setdiff(bands, .band_cloud())
 }
 #' @export
+.tile_bands.base_raster_cube <- function(tile, add_cloud = TRUE) {
+    bands <- .tile_bands.raster_cube(tile, add_cloud)
+    base_bands <- .tile_bands_base(tile)
+    all_bands <- c(bands, base_bands)
+}
+#' @export
 .tile_bands.default <- function(tile, add_cloud = TRUE) {
     tile <- tibble::as_tibble(tile)
     tile <- .cube_find_class(tile)
     bands <- .tile_bands(tile, add_cloud)
     return(bands)
 }
+#' @title Get bands of base data for tile
+#' @noRd
+#' @param samples Data.frame with samples
+#' @return Bands for the first sample
+.tile_bands_base <- function(tile) {
+    # Bands of the first sample governs whole samples data
+    names(tile$base_info[[1]])
+}
 #' @title Set bands in tile file_info.
 #' @rdname .tile_bands
 #' @keywords internal