Merge pull request #1257 from OldLipe/feat/dev-sits

Add support to multiple tiles in summary

Author: gilbertocamara

R/sits_summary.R

@@ -195,9 +195,10 @@ summary.raster_cube <- function(object, ..., tile = NULL, date = NULL) {
 #' @title Summary of a derived cube
 #' @author Felipe Souza, \email{felipe.souza@@inpe.br}
 #' @noRd
-#' @param object data cube
+#' @param object       data cube
 #' @param  ...         Further specifications for \link{summary}.
-#' @param tile A \code{tile}.
+#' @param sample_size  The size of samples will be extracted from the variance
+#'                     cube.
 #' @return Summary of a derived cube
 #'
 #' @examples
@@ -225,53 +226,48 @@ summary.raster_cube <- function(object, ..., tile = NULL, date = NULL) {
 #' }
 #'
 #' @export
-summary.derived_cube <- function(object, ..., tile = NULL) {
+summary.derived_cube <- function(object, ..., sample_size = 10000) {
     .check_set_caller("summary_derived_cube")
-    # Pre-conditional check
-    .check_chr_parameter(tile, allow_null = TRUE)
-    # Extract the chosen tile
-    if (!is.null(tile)) {
-        object <- .summary_check_tile(object, tile)
-    }
-    # get sample size
-    sample_size <- .conf("summary_sample_size")
-    # Get tile name
-    tile <- .default(tile, .cube_tiles(object)[[1]])
-    tile <- .cube_filter_tiles(object, tile)
-    # get the bands
-    band <- .tile_bands(tile)
-    .check_num(
-        x = length(band),
-        min = 1,
-        max = 1,
-        is_integer = TRUE
-    )
-    # extract the file paths
-    files <- .tile_paths(tile)
-    # read the files with terra
-    r <- .raster_open_rast(files)
-    # get the a sample of the values
-    values <- r |>
-        .raster_sample(size = sample_size, na.rm = TRUE)
-    # scale the values
-    band_conf <- .tile_band_conf(tile, band)
-    scale <- .scale(band_conf)
-    offset <- .offset(band_conf)
-    sum <- summary(values * scale + offset)
-    colnames(sum) <- .tile_labels(tile)
-    return(sum)
+    # Get cube labels
+    labels <- unname(.cube_labels(object))
+    # Extract variance values for each tiles using a sample size
+    var_values <- slider::slide(object, function(tile) {
+        # get the bands
+        band <- .tile_bands(tile)
+        # extract the file path
+        file <- .tile_paths(tile)
+        # read the files with terra
+        r <- .raster_open_rast(file)
+        # get the a sample of the values
+        values <- r |>
+            .raster_sample(size = sample_size, na.rm = TRUE)
+        # scale the values
+        band_conf <- .tile_band_conf(tile, band)
+        scale <- .scale(band_conf)
+        offset <- .offset(band_conf)
+        values <- values * scale + offset
+        values
+    })
+    # Combine variance values
+    var_values <- dplyr::bind_rows(var_values)
+    var_values <- summary(var_values)
+    # Update columns name
+    colnames(var_values) <- labels
+    # Return summary values
+    return(var_values)
 }
 #' @title  Summarise variance cubes
 #' @method summary variance_cube
 #' @name summary.variance_cube
 #' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
 #' @description This is a generic function. Parameters depend on the specific
 #' type of input.
-#' @param  object    Object of class "class_cube"
-#' @param ...        Further specifications for \link{summary}.
-#' @param  tile        Tile to be summarized
-#' @param  intervals Intervals to calculate the quantiles
-#' @param  quantiles Quantiles to be shown
+#' @param  object       Object of class "class_cube"
+#' @param  ...          Further specifications for \link{summary}.
+#' @param  sample_size  The size of samples will be extracted from the variance
+#'                      cube.
+#' @param  intervals    Intervals to calculate the quantiles
+#' @param  quantiles    Quantiles to be shown
 #'
 #' @return A summary of a variance cube
 #'
@@ -299,45 +295,47 @@ summary.derived_cube <- function(object, ..., tile = NULL) {
 #' @export
 summary.variance_cube <- function(
         object, ...,
-        tile = NULL,
         intervals = 0.05,
-        quantiles = c ("75%", "80%", "85%", "90%", "95%", "100%")) {
+        sample_size = 10000,
+        quantiles = c("75%", "80%", "85%", "90%", "95%", "100%")) {
     .check_set_caller("summary_variance_cube")
-    # Pre-conditional check
-    .check_chr_parameter(tile, allow_null = TRUE)
-    # Extract the chosen tile
-    if (!is.null(tile)) {
-        object <- .summary_check_tile(object, tile)
-    }
-    # get sample size
-    sample_size <- .conf("summary_sample_size")
-    # Get tile name
-    tile <- .default(tile, .cube_tiles(object)[[1]])
-    tile <- .cube_filter_tiles(object, tile)
-    # get the bands
-    band <- .tile_bands(tile)
-    # extract the file paths
-    files <- .tile_paths(tile)
-    # read the files with terra
-    r <- .raster_open_rast(files)
-    # get the a sample of the values
-    values <- r |>
-        .raster_sample(size = sample_size, na.rm = TRUE)
-    # scale the values
-    band_conf <- .tile_band_conf(tile, band)
-    scale <- .scale(band_conf)
-    offset <- .offset(band_conf)
-    values <- values * scale + offset
-    # calculate the quantiles
-    mat <- apply(values, 2, function(x){
-        stats::quantile(x, probs = seq(0, 1, intervals))
+    # Get cube labels
+    labels <- unname(.cube_labels(object))
+    # Extract variance values for each tiles using a sample size
+    var_values <- slider::slide(object, function(tile) {
+        # get the bands
+        band <- .tile_bands(tile)
+        # extract the file path
+        file <- .tile_paths(tile)
+        # read the files with terra
+        r <- .raster_open_rast(file)
+        # get the a sample of the values
+        values <- r |>
+            .raster_sample(size = sample_size, na.rm = TRUE)
+        # scale the values
+        band_conf <- .tile_band_conf(tile, band)
+        scale <- .scale(band_conf)
+        offset <- .offset(band_conf)
+        values <- values * scale + offset
+        values
     })
-    colnames(mat) <- .tile_labels(tile)
-
-    return(mat[quantiles, ])
+    # Combine variance values
+    var_values <- dplyr::bind_rows(var_values)
+    # Update columns name
+    colnames(var_values) <- labels
+    # Extract quantile for each column
+    var_values <- dplyr::reframe(
+        var_values,
+        dplyr::across(.cols = dplyr::all_of(labels), function(x) {
+            stats::quantile(x, probs = seq(0, 1, intervals))
+        })
+    )
+    # Update row names
+    percent_intervals <- paste0(seq(from = 0, to = 1, by = intervals)*100, "%")
+    rownames(var_values) <- percent_intervals
+    # Return variance values filtered by quantiles
+    return(var_values[quantiles, ])
 }
-#'
-#'
 #' @title  Summarize data cubes
 #' @method summary class_cube
 #' @name summary.class_cube
@@ -346,7 +344,6 @@ summary.variance_cube <- function(
 #' type of input.
 #' @param  object    Object of class "class_cube"
 #' @param ...        Further specifications for \link{summary}.
-#' @param  tile        Tile to be summarized
 #'
 #' @return A summary of a classified cube
 #'
@@ -373,46 +370,50 @@ summary.variance_cube <- function(
 #'     summary(label_cube)
 #' }
 #' @export
-#'
-summary.class_cube <- function(object, ..., tile = NULL) {
+summary.class_cube <- function(object, ...) {
     .check_set_caller("summary_class_cube")
-    # Pre-conditional check
-    .check_chr_parameter(tile, allow_null = TRUE)
-    # Extract the chosen tile
-    if (!is.null(tile)) {
-        object <- .summary_check_tile(object, tile)
-    }
-    # Get tile name
-    tile <- .default(tile, .cube_tiles(object)[[1]])
-    tile <- .cube_filter_tiles(object, tile)
-    # get the bands
-    bands <- .tile_bands(tile)
-    .check_chr_parameter(bands, len_min = 1, len_max = 1)
-    # extract the file paths
-    files <- .tile_paths(tile)
-    # read raster files
-    r <- .raster_open_rast(files)
-    # get a frequency of values
-    class_areas <- .raster_freq(r)
-    # transform to km^2
-    cell_size <- .tile_xres(tile) * .tile_yres(tile)
-    class_areas[["area"]] <-  (class_areas[["count"]] * cell_size) / 10^6
-    # change value to character
-    class_areas <- dplyr::mutate(class_areas,
-        value = as.character(.data[["value"]])
-    )
-    # create a data.frame with the labels
-    labels <- .tile_labels(tile)
-    df1 <- tibble::tibble(value = names(labels), class = unname(labels))
-    # join the labels with the areas
-    sum <- dplyr::full_join(df1, class_areas, by = "value")
-    sum <- dplyr::mutate(sum,
-        area_km2 = signif(.data[["area"]], 2),
-        .keep = "unused"
-    )
-    # remove layer information
-    sum_clean <- sum[, -3] |>
-        tidyr::replace_na(list(layer = 1, count = 0, area_km2 = 0))
-    # show the result
-    return(sum_clean)
+    # Get cube labels
+    labels <- unname(.cube_labels(object))
+    # Extract classes values for each tiles using a sample size
+    classes_areas <- slider::slide(object, function(tile) {
+        # get the bands
+        band <- .tile_bands(tile)
+        # extract the file path
+        file <- .tile_paths(tile)
+        # read the files with terra
+        r <- .raster_open_rast(file)
+        # get a frequency of values
+        class_areas <- .raster_freq(r)
+        # transform to km^2
+        cell_size <- .tile_xres(tile) * .tile_yres(tile)
+        class_areas[["area"]] <-  (class_areas[["count"]] * cell_size) / 10^6
+        # change value to character
+        class_areas <- dplyr::mutate(
+            class_areas, value = as.character(.data[["value"]])
+        )
+        # create a data.frame with the labels
+        labels <- .tile_labels(tile)
+        df1 <- tibble::tibble(value = names(labels), class = unname(labels))
+        # join the labels with the areas
+        sum <- dplyr::full_join(df1, class_areas, by = "value")
+        sum <- dplyr::mutate(sum,
+                             area_km2 = signif(.data[["area"]], 2),
+                             .keep = "unused"
+        )
+        # remove layer information
+        sum_clean <- sum[, -3] |>
+            tidyr::replace_na(list(layer = 1, count = 0, area_km2 = 0))
+
+        sum_clean
+    })
+    # Combine tiles areas
+    classes_areas <- dplyr::bind_rows(classes_areas) |>
+        dplyr::group_by(.data[["value"]], .data[["class"]]) |>
+        dplyr::summarise(
+            count = sum(.data[["count"]]),
+            area_km2 = sum(.data[["area_km2"]]),
+            .groups = "keep") |>
+        dplyr::ungroup()
+    # Return classes areas
+    return(classes_areas)
 }