add histogram function

DESCRIPTION

@@ -230,6 +230,7 @@ Collate:
     'sits_filters.R'
     'sits_geo_dist.R'
     'sits_get_data.R'
+    'sits_histogram.R'
     'sits_imputation.R'
     'sits_labels.R'
     'sits_label_classification.R'

NAMESPACE

@@ -297,6 +297,10 @@ S3method(.values_ts,cases_dates_bands)
 S3method(.view_add_overlay_group,derived_cube)
 S3method(.view_add_overlay_group,raster_cube)
 S3method(.view_add_overlay_group,vector_cube)
+S3method(hist,probs_cube)
+S3method(hist,raster_cube)
+S3method(hist,sits)
+S3method(hist,uncertainty_cube)
 S3method(plot,class_cube)
 S3method(plot,class_vector_cube)
 S3method(plot,geo_distances)

R/sits_histogram.R

@@ -0,0 +1,309 @@
+#' @title  Histogram
+#' @method hist sits
+#' @name hist.sits
+#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
+#' @description This is a generic function. Parameters depend on the specific
+#' type of input.
+#'
+#' @param  x     Object of classes "sits".
+#' @param  ...         Further specifications for \link{hist}.
+#'
+#' @return A summary of the sits tibble.
+#'
+#' @examples
+#' if (sits_run_examples()) {
+#'     hist(samples_modis_ndvi)
+#' }
+#'
+#' @export
+hist.sits <- function(x, ...) {
+    # get frequency table
+    print("histogram of time series not available")
+}
+#' @title  histogram of data cubes
+#' @method hist raster_cube
+#' @name hist.raster_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 classes "raster_cube".
+#' @param  ...         Further specifications for \link{summary}.
+#' @param  tile        Tile to be shown
+#' @param  date        Date to be shown
+#' @param  band        Band to be shown
+#' @param  size.       Number of cells to be sampled
+#'
+#' @return A histogram of one band of  data cube.
+#'
+#' @examples
+#' if (sits_run_examples()) {
+#'     # create a data cube from local files
+#'     data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
+#'     cube <- sits_cube(
+#'         source = "BDC",
+#'         collection = "MOD13Q1-6.1",
+#'         data_dir = data_dir
+#'     )
+#'     hist(cube)
+#' }
+#'
+#' @export
+hist.raster_cube <- function(x, ...,
+                             tile = x[["tile"]][[1]],
+                             date = NULL,
+                             band = NULL,
+                             size = 10000) {
+    .check_set_caller("summary_raster_cube")
+    # Pre-conditional check
+    .check_date_parameter(date, allow_null = TRUE)
+    .check_chr_parameter(tile, allow_null = TRUE)
+
+    # is tile inside the cube?
+    .check_chr_contains(
+        x = x[["tile"]],
+        contains = tile,
+        case_sensitive = FALSE,
+        discriminator = "one_of",
+        can_repeat = FALSE,
+        msg = .conf("messages", "sits_hist_tile")
+    )
+    # filter the tile to be processed
+    tile <- .cube_filter_tiles(cube = x, tiles = tile)
+    if (.has(date)) {
+        # is this a valid date?
+        date <- as.Date(date)
+        .check_that(date %in% .tile_timeline(tile),
+                    msg = .conf("messages", "sits_hist_date")
+        )
+    } else {
+        date <- .tile_timeline(tile)[[1]]
+    }
+    if (.has(band)) {
+        # is this a valid band?
+        .check_that(band %in% .tile_bands(tile),
+                    msg = .conf("messages", "sits_hist_band")
+        )
+    } else {
+        band <- .tile_bands(tile)[[1]]
+    }
+    # select the file to be plotted
+    band_file <- .tile_path(tile, band, date)
+    # scale and offset
+    band_conf <- .tile_band_conf(tile, band)
+    band_scale <- .scale(band_conf)
+    band_offset <- .offset(band_conf)
+    #
+    r <- terra::rast(band_file)
+    values <- terra::spatSample(r, size = size)
+    values <- values * band_scale + band_offset
+
+    density_plot <-
+        values |>
+        ggplot2::ggplot(ggplot2::aes(x = .data[[band]])) +
+        ggplot2::geom_density(
+            ggplot2::aes(x = .data[[band]]),
+            color = "#000000",
+            fill = "#94C293",
+            linewidth = 0.8,
+            alpha = 0.50,
+            show.legend = FALSE
+        ) +
+        ggplot2::scale_x_continuous(limits = c(0.0, 1.0)) +
+        ggplot2::xlab("Ground reflectance") +
+        ggplot2::ylab("") +
+        ggplot2::ggtitle(paste("Distribution of Values for band",
+                               band,"date", date))
+
+    return(suppressWarnings(density_plot))
+}
+#' @title  histogram of prob cubes
+#' @method hist probs_cube
+#' @name hist.probs_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 classes "raster_cube".
+#' @param  ...         Further specifications for \link{summary}.
+#' @param  tile        Tile to be shown
+#' @param  label       Label to be shown
+#' @param  size        Number of cells to be sampled
+#'
+#' @return A histogram of one label of a probability cube.
+#'
+#' @examples
+#' if (sits_run_examples()) {
+#'     # create a data cube from local files
+#'     data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
+#'     modis_cube <- sits_cube(
+#'         source = "BDC",
+#'         collection = "MOD13Q1-6.1",
+#'         data_dir = data_dir
+#'     )
+#'     rfor_model <- sits_train(samples_modis_ndvi, sits_rfor())
+#'     probs_cube <- sits_classify(
+#'         data = modis_cube,
+#'         ml_model = rfor_model,
+#'         output_dir = tempdir()
+#'     )
+#'     hist(probs_cube, label = "Forest")
+#' }
+#'
+#' @export
+hist.probs_cube <- function(x, ...,
+                             tile = x[["tile"]][[1]],
+                             labels = NULL,
+                             size = 10000) {
+    .check_set_caller("sits_hist_raster_cube")
+    # Pre-conditional check
+    .check_chr_parameter(tile, allow_null = TRUE)
+
+    # is tile inside the cube?
+    .check_chr_contains(
+        x = x[["tile"]],
+        contains = tile,
+        case_sensitive = FALSE,
+        discriminator = "one_of",
+        can_repeat = FALSE,
+        msg = .conf("messages", "sits_hist_tile")
+    )
+    # filter the tile to be processed
+    tile <- .cube_filter_tiles(cube = x, tiles = tile)
+    # check the labels
+    if (.has(labels)) {
+        # is this a valid label?
+        .check_that(labels %in% .tile_labels(tile),
+                    msg = .conf("messages", "sits_hist_label")
+        )
+    } else {
+        labels <- .tile_labels(tile)
+    }
+    # select the file to be plotted
+    probs_file <- .tile_path(tile)
+    band <- .tile_bands(tile)
+    # scale and offset
+    band_conf <- .tile_band_conf(tile, band)
+    band_scale <- .scale(band_conf)
+    band_offset <- .offset(band_conf)
+
+    # recover all labels
+    all_labels <- .tile_labels(tile)
+    layers <- seq_len(length(all_labels))
+    names(layers) <- all_labels
+    # read file
+    r <- terra::rast(probs_file)
+    # select layer
+    layers <- layers[labels]
+    values <- terra::spatSample(r[[layers]], size = size)
+    values <- values * band_scale + band_offset
+    colnames(values) <- labels
+    colors_sits <- .colors_get(labels)
+    values <- tidyr::pivot_longer(values, cols = dplyr::all_of(unname(labels)))
+    # values[["color"]] <- colors_sits[values[["name"]]]
+    density_plot <-
+        values |>
+        ggplot2::ggplot(ggplot2::aes(x = .data[["value"]])) +
+        ggplot2::geom_density(
+            ggplot2::aes(color = .data[["name"]],
+                         fill = .data[["name"]]),
+            linewidth = 0.8,
+            alpha = 0.50
+        ) +
+        ggplot2::scale_x_continuous(limits = c(0.0, 1.0)) +
+        ggplot2::xlab("Probability") +
+        ggplot2::ylab("") +
+        ggplot2::theme(legend.title = ggplot2::element_blank()) +
+        ggplot2::ggtitle(paste("Distribution of probabilities for labels",
+                               paste(labels, collapse = ",")))
+
+    return(suppressWarnings(density_plot))
+}
+
+#' @title  Histogram uncertainty cubes
+#' @method hist uncertainty_cube
+#' @name hist.uncertainty_cube
+#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
+#' @description This is a generic function. Parameters depend on the specific
+#' type of input.
+#' @param  x         Object of class "variance_cube"
+#' @param ...        Further specifications for \link{hist}.
+#' @param  tile      Tile to be summarized
+#' @param  size      Sample size
+#'
+#' @return A histogram of a uncertainty cube
+#'
+#' @examples
+#' if (sits_run_examples()) {
+#'     # create a data cube from local files
+#'     data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
+#'     cube <- sits_cube(
+#'         source = "BDC",
+#'         collection = "MOD13Q1-6.1",
+#'         data_dir = data_dir
+#'     )
+#'     # create a random forest model
+#'     rfor_model <- sits_train(samples_modis_ndvi, sits_rfor())
+#'     # classify a data cube
+#'     probs_cube <- sits_classify(
+#'         data = cube, ml_model = rfor_model, output_dir = tempdir()
+#'     )
+#'     uncert_cube <- sits_uncertainty(
+#'         cube = probs_cube,
+#'         output_dir = tempdir()
+#'     )
+#'     hist(uncert_cube)
+#' }
+#' @export
+hist.uncertainty_cube <- function(
+        x, ...,
+        tile = x[["tile"]][[1]],
+        size = 10000) {
+    .check_set_caller("sits_hist_uncertainty_cube")
+    # Pre-conditional check
+    .check_chr_parameter(tile, allow_null = TRUE)
+    # Extract the chosen tile
+    .check_chr_contains(
+        x = x[["tile"]],
+        contains = tile,
+        case_sensitive = FALSE,
+        discriminator = "one_of",
+        can_repeat = FALSE,
+        msg = .conf("messages", "sits_hist_tile")
+    )
+    # filter the tile to be processed
+    tile <- .cube_filter_tiles(cube = x, tiles = tile)
+
+    # select the file to be plotted
+    uncert_file <- .tile_path(tile)
+    band <- .tile_bands(tile)
+    # scale and offset
+    band_conf <- .tile_band_conf(tile, band)
+    band_scale <- .scale(band_conf)
+    band_offset <- .offset(band_conf)
+    # read file
+    r <- terra::rast(uncert_file)
+    values <- terra::spatSample(r, size = size)
+    values <- values * band_scale + band_offset
+    max <- max(values)
+    colnames(values) <- band
+    density_plot <-
+        values |>
+        ggplot2::ggplot(ggplot2::aes(x = .data[[band]])) +
+        ggplot2::geom_density(
+            ggplot2::aes(x = .data[[band]]),
+            color = "#000000",
+            fill = "#94C293",
+            linewidth = 0.8,
+            alpha = 0.50,
+            show.legend = FALSE
+        ) +
+        ggplot2::scale_x_continuous(limits = c(0.0, max)) +
+        ggplot2::xlab("Uncertainty") +
+        ggplot2::ylab("") +
+        ggplot2::ggtitle(paste("Distribution of uncertainty for band", band))
+
+    return(suppressWarnings(density_plot))
+
+}
+

inst/extdata/config_messages.yml

@@ -370,6 +370,11 @@ sits_get_data_default: "invalid samples - check documentation"
 sits_get_data_data_frame: "missing lat/long information in data frame"
 sits_get_data_sf: "sf objects need a column with an id for each polygon\n please include this column name in the 'pol_id' parameter"
 sits_get_data_shp: "shp objects need a column with an id for each polygon\n please include this column name in the 'pol_id' parameter"
+sits_hist_raster_cube: "invalid input data to compute histogram"
+sits_hist_tile: "tile is not part of the cube"
+sits_hist_label: "labels is not one of cube labels"
+sits_hist_date: "date is not part of cube timeline"
+sits_hist_band: "band not available in the cube"
 sits_kfold_validate: "ml_method is not a valid sits method"
 sits_kfold_validate_samples: "sits_kfold_validate() requires labelled set of time series"
 sits_kfold_validate_windows: "sits_kfold_validate() works only with 1 core in Windows"