Merge pull request #24 from EVS-GIS/tooltip_metric_map

Tooltip metric map
EVS-GIS · Jan 30, 2024 · c6078ef · c6078ef
2 parents 664c6dd + b55308b
commit c6078ef
Show file tree

Hide file tree

Showing 5 changed files with 58 additions and 15 deletions.
diff --git a/R/fct_map.R b/R/fct_map.R
@@ -219,20 +219,20 @@ map_region_clicked <- function(map,
                      radius = 3,
                      weight = 0.5,
                      opacity = 0.9,
-                     color = "orange",
-                     fillColor = "orange",
+                     color = "#D0D0D0",
+                     fillColor = "#323232",
                      fillOpacity = 0.9,
                      popup = ~nomprincip,
                      group = params_map_group()[["roe"]]
     ) %>%
-    # ROE layer hidden by default
+    # hydrometric stations layer hidden by default
     hideGroup(params_map_group()[["roe"]]) %>%
     addCircleMarkers(data = data_get_station_hubeau(region_click$id),
                      radius = 3,
                      weight = 0.5,
                      opacity = 0.9,
-                     color = "blue",
-                     fillColor = "blue",
+                     color = "#E5F6FF",
+                     fillColor = "#33B1FF",
                      fillOpacity = 0.9,
                      popup = ~libelle_station,
                      group = params_map_group()[["hydro_station"]]
@@ -427,10 +427,13 @@ map_metric <- function(map, wms_params = params_wms()$metric,
 #' @param map A Leaflet map object.
 #' @param selected_axis A data frame containing selected axe to be displayed.
 #' @param region_axis A data frame containing region-specific axes to be displayed.
+#' @param main_metric text with the main selected metric name.
+#' @param second_metric text with the second axis selected metric name.
 #'
 #' @return A modified Leaflet map object with DGO axes added.
 #'
 #' @importFrom leaflet clearGroup addPolylines highlightOptions pathOptions
+#' @importFrom htmltools HTML
 #'
 #' @examples
 #' # Create a basic Leaflet map
@@ -446,11 +449,24 @@ map_metric <- function(map, wms_params = params_wms()$metric,
 #' region_axes <- network_axis
 #'
 #' # Add DGO axes to the map
-#' my_map <- map_dgo_axis(my_map, selected_axes, region_axes)
+#' my_map <- map_dgo_axis(my_map, selected_axes, region_axes,
+#'                         main_metric = "active_channel_width", second_metric = "talweg_slope")
 #' my_map
 #'
 #' @export
-map_dgo_axis <- function(map, selected_axis, region_axis) {
+map_dgo_axis <- function(map, selected_axis, region_axis, main_metric, second_metric) {
+
+  # create HTML conditional tooltip labels
+  tooltip_label <- NULL
+  if (!is.null(main_metric) && is.null(second_metric)){
+    tooltip_label <- lapply(paste0('<span style="color:blue;"> <b>', selected_axis[[main_metric]], '</b> </span>'),
+                            htmltools::HTML)
+  } else if (!is.null(main_metric) && !is.null(second_metric)){
+    tooltip_label <- lapply(paste0('<span style="color:blue;"> <b>', selected_axis[[main_metric]], '</b> </span> <br/>',
+                                   '<span style="color:#FC9D5A;"> <b>', selected_axis[[second_metric]], '</b> </span>'),
+                            htmltools::HTML)
+  }
+
   map %>%
     clearGroup(params_map_group()$dgo_axis) %>%
     clearGroup(params_map_group()$axis) %>%
@@ -460,6 +476,7 @@ map_dgo_axis <- function(map, selected_axis, region_axis) {
       layerId = ~fid,
       weight = 5,
       color = "#ffffff00",
+      label = tooltip_label,
       opacity = 1,
       highlightOptions = highlightOptions(
         opacity = 1,
@@ -727,12 +744,13 @@ map_legend_wms_overlayer <- function(wms_params){
 #' This function generates an HTML representation of a legend entry for a vector overlay layer. The legend entry consists of a colored circle with a label indicating the layer's name.
 #'
 #' @param layer_label A character string representing the label or name of the vector overlay layer.
+#' @param color text the legend marker color.
 #'
 #' @return An HTML div element representing the legend entry for the vector overlay layer.
 #'
 #' @examples
 #' # Create a legend entry for a vector overlay layer
-#' legend_entry <- map_legend_vector_overlayer(layer_label = "ROE")
+#' legend_entry <- map_legend_vector_overlayer(layer_label = "ROE", color = "blue")
 #' print(legend_entry)
 #'
 #' @importFrom htmltools div span

diff --git a/R/mod_documentation.R b/R/mod_documentation.R
@@ -20,7 +20,7 @@ mod_documentation_ui <- function(id){
             <p>L&#39;application dispose aujourd&#39;hui d&#39;un module d&#39;exploration des donn&eacute;es permettant de visualiser les diff&eacute;rentes m&eacute;triques mises &agrave; disposition pour l&#39;analyse de bassin versant.</p>
            "),
       HTML("
-            <p><strong>Contact</strong> : Louis Mani&egrave;re (CNRS UMR 5600, Environnement Ville Soci&eacute;t&eacute;) - <a href='mailto:[email protected]?subject=Application%20MAPDO'>louis.maniere@ens-lyon.fr</a></p>
+            <p><strong>Contact</strong> : Lise Vaudor (CNRS UMR 5600, Environnement Ville Soci&eacute;t&eacute;) - <a href='mailto:[email protected]?subject=Application%20MAPDO'>lise.vaudor@ens-lyon.fr</a></p>
          "),
       tags$a(
         href = "https://evs-gis.github.io/mapdowebsite/",

diff --git a/R/mod_explore.R b/R/mod_explore.R
@@ -306,12 +306,12 @@ mod_explore_server <- function(id){
         # ROE
         if (any(input$exploremap_groups %in% params_map_group()[["roe"]])) {
           map_legend_vector_overlayer(layer_label = "Référentiel des Obstacles à l'Ecoulement",
-                                      color = "orange")
+                                      color = "#323232")
         },
         # Station hydrométrique
         if (any(input$exploremap_groups %in% params_map_group()[["hydro_station"]])) {
           map_legend_vector_overlayer(layer_label = "Station hydrométrique",
-                                      color = "blue")
+                                      color = "#33B1FF")
         },
         style = "margin-bottom: 10px;"
       ) # div
@@ -409,7 +409,8 @@ mod_explore_server <- function(id){
 
         # map dgo axis when axis clicked and metric selected
         leafletProxy("exploremap") %>%
-          map_dgo_axis(selected_axis = r_val$dgo_axis, region_axis = r_val$network_region_axis) %>%
+          map_dgo_axis(selected_axis = r_val$dgo_axis, region_axis = r_val$network_region_axis,
+                       main_metric = r_val$selected_metric, second_metric = r_val$selected_profile_metric) %>%
           map_axis_start_end(axis_start_end = r_val$axis_start_end, region_axis = r_val$network_region_axis)
 
         # create or update profile dataset with new axis
@@ -508,6 +509,7 @@ mod_explore_server <- function(id){
 
         # update profile with new metric selected
         if (r_val$profile_display == TRUE){
+
           proxy_main_axe <-
             lg_profile_update_main(
               data = r_val$selected_axis_df,
@@ -537,6 +539,11 @@ mod_explore_server <- function(id){
                                                      choices = utile_get_metric_type(params_metrics_choice()),
                                                      selected  = utile_get_metric_type(params_metrics_choice())[1])
 
+          # update dgo on axis to reset tooltip
+          leafletProxy("exploremap") %>%
+            map_dgo_axis(selected_axis = r_val$dgo_axis, region_axis = r_val$network_region_axis,
+                         main_metric = r_val$selected_metric, second_metric = r_val$selected_profile_metric)
+
           # plot single axe with metric selected
           r_val$plot = lg_profile_main(data = r_val$selected_axis_df,
                                        y = r_val$selected_axis_df[[r_val$selected_metric]],
@@ -596,6 +603,11 @@ mod_explore_server <- function(id){
         r_val$selected_profile_metric_name = params_metrics_choice()[[input$profile_metric_type]]$metric_type_values[[input$profile_metric]]$metric_title
         r_val$selected_profile_metric_type = params_metrics_choice()[[input$profile_metric_type]]$metric_type_title
 
+        # update map to change tooltip labels
+        leafletProxy("exploremap") %>%
+          map_dgo_axis(selected_axis = r_val$dgo_axis, region_axis = r_val$network_region_axis,
+                       main_metric = r_val$selected_metric, second_metric = r_val$selected_profile_metric)
+
         # create the list to add trace and layout to change second axe plot
         proxy_second_axe <- lg_profile_second(data = r_val$selected_axis_df,
                                               y = r_val$selected_axis_df[[r_val$selected_profile_metric]],
@@ -617,6 +629,12 @@ mod_explore_server <- function(id){
 
       updateRadioButtons(session, "profile_metric", selected = character(0))
 
+      r_val$selected_profile_metric = NULL
+      # update dgo on axis to reset tooltip
+      leafletProxy("exploremap") %>%
+        map_dgo_axis(selected_axis = r_val$dgo_axis, region_axis = r_val$network_region_axis,
+                     main_metric = r_val$selected_metric, second_metric = r_val$selected_profile_metric)
+
     })
 
     ### EVENT FILTER ####

diff --git a/man/map_dgo_axis.Rd b/man/map_dgo_axis.Rd
diff --git a/man/map_legend_vector_overlayer.Rd b/man/map_legend_vector_overlayer.Rd