improvements to view SOM maps

Author: gilbertocamara

R/api_conf.R

@@ -1283,12 +1283,13 @@ NULL
                          base_groups = base_groups,
                          overlay_groups = vector()
                          )
-    class(sits_leaflet) <- "sits_leaflet"
     # put the object in the global sits environment
     sits_env[["leaflet"]] <- sits_leaflet
 
     # create a global object for controlling leaflet false color legend
     sits_env[["leaflet_false_color_legend"]] <- FALSE
+    # create a global object for controlling leaflet SOM neuron color display
+    sits_env[["leaflet_som_colors"]] <- FALSE
     return(invisible(sits_leaflet))
 }
 #' @title Clean global leaflet

R/api_view.R

@@ -55,10 +55,11 @@
 #' @param  group         Leaflet group to be added
 #' @param  legend        Named vector that associates labels to colors.
 #' @param  palette       Palette provided in the configuration file.
+#' @param  radius        Radius of circle markers
 #' @return               A leaflet object
 #'
 .view_samples <- function(leaf_map, samples, group,
-                          legend, palette) {
+                          legend, palette, radius) {
     .check_set_caller(".view_samples")
     # first select unique locations
     samples <- dplyr::distinct(
@@ -100,7 +101,7 @@
         leaflet::addCircleMarkers(
             data = samples,
             color = ~ factpal(label),
-            radius = 4,
+            radius = radius,
             stroke = FALSE,
             fillOpacity = 1,
             group = group
@@ -121,6 +122,86 @@
     }
     return(leaf_map)
 }
+#' @title  Visualize a set of neurons
+#' @name .view_neurons
+#' @keywords internal
+#' @noRd
+#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
+#'
+#' @param  leaf_map      Leaflet map
+#' @param  samples       Data.frame with columns "longitude", "latitude"
+#'                       and "label"
+#' @param  labels        Labels to display
+#' @param  group         Leaflet group to be added
+#' @param  legend        Named vector that associates labels to colors.
+#' @param  palette       Palette provided in the configuration file.
+#' @param  radius        Radius of circle markers
+#' @return               A leaflet object
+#'
+.view_neurons <- function(leaf_map, samples, labels, group,
+                          legend, palette, radius) {
+    .check_set_caller(".view_neurons")
+    # first select unique locations
+    samples <- dplyr::distinct(
+        samples,
+        .data[["longitude"]],
+        .data[["latitude"]],
+        .data[["label"]]
+    )
+    # convert tibble to sf
+    samples <- sf::st_as_sf(
+        samples[c("longitude", "latitude", "label")],
+        coords = c("longitude", "latitude"),
+        crs = "EPSG:4326"
+    )
+    # get the bounding box
+    samples_bbox <- sf::st_bbox(samples)
+    # get colors
+    colors <- .colors_get(
+        labels = labels,
+        legend = legend,
+        palette = palette,
+        rev = TRUE
+    )
+    # create a palette of colors
+    factpal <- leaflet::colorFactor(
+        palette = colors,
+        domain = labels
+    )
+    # add samples to leaflet
+    leaf_map <- leaf_map |>
+        leaflet::flyToBounds(
+            lng1 = samples_bbox[["xmin"]],
+            lat1 = samples_bbox[["ymin"]],
+            lng2 = samples_bbox[["xmax"]],
+            lat2 = samples_bbox[["ymax"]]
+        ) |>
+        leaflet::addCircleMarkers(
+            data = samples,
+            color = ~ factpal(label),
+            radius = radius,
+            stroke = FALSE,
+            fillOpacity = 1,
+            group = group
+        )
+    # recover overlay groups
+    overlay_groups <- sits_env[["leaflet"]][["overlay_groups"]]
+    # add legend if it does not exist already
+    if (!any(grepl("samples", overlay_groups)) &&
+        !any(grepl("class", overlay_groups)) &&
+        !sits_env[["leaflet_som_colors"]]) {
+        leaf_map <- leaf_map |>
+            leaflet::addLegend(
+                position = "topright",
+                pal = factpal,
+                values = labels,
+                title = "Classes",
+                opacity = 1
+            )
+        sits_env[["leaflet_som_colors"]] <- TRUE
+    }
+    return(leaf_map)
+}
 #' @title  Include leaflet to view segments
 #' @name .view_segments
 #' @keywords internal

R/sits_view.R

@@ -84,6 +84,7 @@
 #' @param  last_quantile  Last quantile for stretching images
 #' @param  leaflet_megabytes Maximum size for leaflet (in MB)
 #' @param  id_neurons    Neurons from the SOM map to be shown.
+#' @param  radius        Radius of circle markers
 #' @param  add           Add image to current leaflet
 #'
 #' @return               A leaflet object containing either samples or
@@ -150,6 +151,7 @@ sits_view <- function(x, ...) {
 sits_view.sits <- function(x, ...,
                            legend = NULL,
                            palette = "Set3",
+                           radius = 5,
                            add = FALSE) {
     .check_set_caller("sits_view_sits")
     # precondition
@@ -175,7 +177,8 @@ sits_view.sits <- function(x, ...,
             samples = x,
             group = "samples",
             legend = legend,
-            palette = palette
+            palette = palette,
+            radius = radius
     )
     # append samples to overlay groups
     overlay_groups <- append(overlay_groups, "samples")
@@ -204,6 +207,7 @@ sits_view.som_map <- function(x, ...,
                               id_neurons,
                               legend = NULL,
                               palette = "Harmonic",
+                              radius = 5,
                               add = FALSE) {
     .check_set_caller("sits_view_som_map")
     # check id_neuron
@@ -222,22 +226,30 @@ sits_view.som_map <- function(x, ...,
     overlay_groups <- sits_env[["leaflet"]][["overlay_groups"]]
     leaf_map <- sits_env[["leaflet"]][["leaf_map"]]
 
-    # assign group name
-    group <- paste("neurons", paste(id_neurons, collapse = " "))
+    # get the samples
+    samples <- x[["data"]]
+    labels <- sort(unique(samples[["label"]]))
 
-    # first select unique locations
-    samples <- dplyr::filter(
-        x[["data"]], .data[["id_neuron"]] %in% !!id_neurons
-    )
-    leaf_map <- leaf_map |>
-        .view_samples(
-            samples = samples,
-            group = group,
-            legend = legend,
-            palette = palette
+    for (id in id_neurons) {
+        # assign group name (one neuron per)
+        group <- paste("neuron", id)
+
+        # first select unique locations
+        samples_neuron <- dplyr::filter(
+            samples, .data[["id_neuron"]] == id
         )
-    # append samples to overlay groups
-    overlay_groups <- append(overlay_groups, group)
+        leaf_map <- leaf_map |>
+            .view_neurons(
+                samples = samples_neuron,
+                labels = labels,
+                group = group,
+                legend = legend,
+                palette = palette,
+                radius = radius
+            )
+        # append samples to overlay groups
+        overlay_groups <- append(overlay_groups, group)
+    }
     # add layers control and update global leaflet-related variables
     leaf_map <- leaf_map |>
         .view_add_layers_control(overlay_groups) |>
@@ -263,7 +275,7 @@ sits_view.raster_cube <- function(x, ...,
                                   max_cog_size = 2048,
                                   first_quantile = 0.02,
                                   last_quantile = 0.98,
-                                  leaflet_megabytes = 32,
+                                  leaflet_megabytes = 64,
                                   add = FALSE) {
     # set caller for errors
     .check_set_caller("sits_view_raster_cube")