include uncertainty plot

NAMESPACE

@@ -257,6 +257,7 @@ S3method(plot,som_evaluate_cluster)
 S3method(plot,som_map)
 S3method(plot,torch_model)
 S3method(plot,uncertainty_cube)
+S3method(plot,uncertainty_vector_cube)
 S3method(plot,variance_cube)
 S3method(plot,vector_cube)
 S3method(plot,xgb_model)
@@ -281,6 +282,7 @@ S3method(sits_bands,raster_cube)
 S3method(sits_bands,sits)
 S3method(sits_bands,sits_model)
 S3method(sits_bands,tbl_df)
+S3method(sits_bands,vector_cube)
 S3method(sits_bbox,default)
 S3method(sits_bbox,raster_cube)
 S3method(sits_bbox,sits)

R/api_plot_raster.R

@@ -483,7 +483,7 @@
 #'
 .plot_tmap_params <- function(tmap_user) {
     # reset the tmap params
-    tmap::tmap_options_reset()
+    suppressMessages(tmap::tmap_options_reset())
     # get the tmap defaults
     tmap_options <- list(
         graticules_labels_size =
@@ -508,7 +508,7 @@
                         keys, collapse = " ")
         )
         for (k in names(tmap_user))
-            tmap_options <- tmap_user[[k]]
+            tmap_options[[k]] <- tmap_user[[k]]
     }
     # set tmap options
     tmap::tmap_options(scale = as.numeric(tmap_options[["scale"]]),

R/api_plot_vector.R

@@ -151,3 +151,60 @@
 
     return(suppressWarnings(p))
 }
+#' @title  Plot uncertainty vector cube
+#' @name   .plot_uncertainty_vector
+#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
+#' @description plots an uncertainty vector cube
+#' @keywords internal
+#' @noRd
+#' @param  tile          Tile to be plotted.
+#' @param  palette       A sequential RColorBrewer palette
+#' @param  rev           Revert the color of the palette?
+#' @param  tmap_options  Named vector with optional tmap parameters
+#'
+#' @return               A plot object
+#'
+.plot_uncertainty_vector <- function(tile,
+                                     palette,
+                                     rev,
+                                     tmap_options) {
+    # verifies if stars package is installed
+    .check_require_packages("stars")
+    # verifies if tmap package is installed
+    .check_require_packages("tmap")
+    # precondition - check color palette
+    .check_palette(palette)
+    # revert the palette
+    if (rev) {
+        palette <- paste0("-", palette)
+    }
+    # get the segements to be plotted
+    sf_seg <- .segments_read_vec(tile)
+    # set the tmap options
+    tmap_options <- .plot_tmap_params(tmap_options)
+    # obtain the uncertainty type
+    uncert_type <- .vi(tile)$band
+    # plot the segments by facet
+    p <- tmap::tm_shape(sf_seg) +
+        tmap::tm_polygons(uncert_type, palette = palette) +
+        tmap::tm_graticules(
+            labels.size = tmap_options[["graticules_labels_size"]]
+        ) +
+        tmap::tm_compass() +
+        tmap::tm_layout(
+            fontfamily      = tmap_options[["font_family"]],
+            legend.bg.color = tmap_options[["legend_bg_color"]],
+            legend.bg.alpha = tmap_options[["legend_bg_alpha"]],
+            legend.title.size = tmap_options[["legend_title_size"]],
+            legend.text.size = tmap_options[["legend_text_size"]],
+            legend.width     = tmap_options[["legend_width"]],
+            legend.height    = tmap_options[["legend_height"]],
+            outer.margins = c(0.00001, 0.00001, 0.00001, 0.00001),
+            inner.margins = c(0, 0, 0, 0),
+            between.margin = 0,
+            asp = 0
+        ) +
+        tmap::tm_borders(lwd = 0.2)
+
+    return(suppressWarnings(p))
+}

R/sits_bands.R

@@ -63,6 +63,20 @@ sits_bands.raster_cube <- function(x) {
 }
 #' @rdname sits_bands
 #' @export
+sits_bands.vector_cube <- function(x) {
+    bands_lst <- slider::slide(x, function(tile) {
+        bands_tile <- .vi(tile)$band
+        return(bands_tile)
+    })
+    bands <- unique(bands_lst)
+    .check_that(length(bands) == 1,
+                local_msg = "tiles have different bands",
+                msg = "cube is inconsistent"
+    )
+    return(unlist(bands))
+}
+#' @rdname sits_bands
+#' @export
 sits_bands.patterns <- function(x) {
     return(sits_bands.sits(x))
 }

R/sits_plot.R

@@ -905,6 +905,101 @@ plot.uncertainty_cube <- function(x, ...,
 
     return(p)
 }
+#' @title  Plot uncertainty vector cubes
+#' @name   plot.uncertainty_vector_cube
+#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
+#' @description plots a probability cube using stars
+#'
+#' @param  x             Object of class "probs_vector_cube".
+#' @param  ...           Further specifications for \link{plot}.
+#' @param tile           Tile to be plotted.
+#' @param palette        RColorBrewer palette
+#' @param rev            Reverse order of colors in palette?
+#' @param  tmap_options  Named list with optional tmap parameters
+#'                       max_cells (default: 1e+06)
+#'                       scale (default: 1.0)
+#'                       graticules_labels_size (default: 0.7)
+#'                       legend_title_size (default: 1.0)
+#'                       legend_text_size (default: 1.0)
+#'                       legend_bg_color (default: "white")
+#'                       legend_bg_alpha (default: 0.5)
+#' @return               A plot containing probabilities associated
+#'                       to each class for each pixel.
+#'
+#'
+#' @examples
+#' if (sits_run_examples()) {
+#'     # create a random forest model
+#'     rfor_model <- sits_train(samples_modis_ndvi, sits_rfor())
+#'     # create a data cube from local files
+#'     data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
+#'     cube <- sits_cube(
+#'         source = "BDC",
+#'         collection = "MOD13Q1-6",
+#'         data_dir = data_dir
+#'     )
+#'     # segment the image
+#'     segments <- sits_segment(
+#'         cube = cube,
+#'         seg_fn = sits_slic(step = 5,
+#'                            compactness = 1,
+#'                            dist_fun = "euclidean",
+#'                            avg_fun = "median",
+#'                            iter = 20,
+#'                            minarea = 10,
+#'                            verbose = FALSE),
+#'         output_dir = tempdir()
+#'     )
+#'     # classify a data cube
+#'     probs_vector_cube <- sits_classify(
+#'         data = segments,
+#'         ml_model = rfor_model,
+#'         output_dir = tempdir()
+#'     )
+#'     # measure uncertainty
+#'     uncert_vector_cube <- sits_uncertainty(
+#'         cube = probs_vector_cube,
+#'         type = "margin",
+#'         output_dir = tempdir()
+#'     )
+#'     # plot the resulting uncertainty cube
+#'     plot(uncert_vector_cube)
+#' }
+#'
+#' @export
+#'
+plot.uncertainty_vector_cube <- function(x, ...,
+                                         tile = x$tile[[1]],
+                                         palette =  "RdYlGn",
+                                         rev = FALSE,
+                                         tmap_options = NULL) {
+    # check for color_palette parameter (sits 1.4.1)
+    dots <- list(...)
+    if (missing(palette) && "color_palette" %in% names(dots)) {
+        warning("please use palette in place of color_palette")
+        palette <- dots[["color_palette"]]
+    }
+    # precondition
+    .check_chr_contains(
+        x = x$tile,
+        contains = tile,
+        case_sensitive = FALSE,
+        discriminator = "one_of",
+        can_repeat = FALSE,
+        msg = "tile is not included in the cube"
+    )
+
+    # filter the cube
+    tile <- .cube_filter_tiles(cube = x, tiles = tile)
+
+    # plot the probs vector cube
+    p <- .plot_uncertainty_vector(tile = tile,
+                                   palette = palette,
+                                   rev = rev,
+                                   tmap_options = tmap_options)
+
+    return(p)
+}
 #' @title  Plot classified images
 #' @name   plot.class_cube
 #' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}

R/sits_segmentation.R

@@ -240,7 +240,7 @@ sits_slic <- function(data = NULL,
     # step is OK?
     .check_int_parameter(step, min = 1, max = 500)
     # compactness is OK?
-    .check_int_parameter(compactness, min = 1, max = 50)
+    .check_num_parameter(compactness, min = 0.1, max = 50)
     # iter is OK?
     .check_int_parameter(iter, min = 10, max = 100)
     # minarea is OK?

inst/extdata/config_internals.yml

@@ -250,7 +250,7 @@ tmap:
         legend_width: 1.0
         legend_position: ["left", "bottom"]
         legend_height: 1.0
-        scale: 1.5
+        scale: 1.0
         font_family: "plex_sans"
 
 # maxbytes for leaflet (in MB)