diff --git a/R/sits_summary.R b/R/sits_summary.R index bf4453b8..15ad0f91 100644 --- a/R/sits_summary.R +++ b/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,41 +226,35 @@ 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 @@ -267,11 +262,12 @@ summary.derived_cube <- function(object, ..., tile = NULL) { #' @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) } diff --git a/man/summary.class_cube.Rd b/man/summary.class_cube.Rd index bdaf6a9d..21f93251 100644 --- a/man/summary.class_cube.Rd +++ b/man/summary.class_cube.Rd @@ -4,14 +4,12 @@ \alias{summary.class_cube} \title{Summarize data cubes} \usage{ -\method{summary}{class_cube}(object, ..., tile = NULL) +\method{summary}{class_cube}(object, ...) } \arguments{ \item{object}{Object of class "class_cube"} \item{...}{Further specifications for \link{summary}.} - -\item{tile}{Tile to be summarized} } \value{ A summary of a classified cube diff --git a/man/summary.variance_cube.Rd b/man/summary.variance_cube.Rd index c0ca3405..c713bf95 100644 --- a/man/summary.variance_cube.Rd +++ b/man/summary.variance_cube.Rd @@ -7,8 +7,8 @@ \method{summary}{variance_cube}( object, ..., - tile = NULL, intervals = 0.05, + sample_size = 10000, quantiles = c("75\%", "80\%", "85\%", "90\%", "95\%", "100\%") ) } @@ -17,10 +17,11 @@ \item{...}{Further specifications for \link{summary}.} -\item{tile}{Tile to be summarized} - \item{intervals}{Intervals to calculate the quantiles} +\item{sample_size}{The size of samples will be extracted from the variance +cube.} + \item{quantiles}{Quantiles to be shown} } \value{