From 26e884567d63b68b4e3747b3c277a7dda4fb27a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mani=C3=A8re=20Louis?= Date: Mon, 29 Jan 2024 11:07:49 +0100 Subject: [PATCH 1/5] update contact documentation --- R/mod_documentation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/mod_documentation.R b/R/mod_documentation.R index 8a4ebbe..e3ab30b 100644 --- a/R/mod_documentation.R +++ b/R/mod_documentation.R @@ -20,7 +20,7 @@ mod_documentation_ui <- function(id){

L'application dispose aujourd'hui d'un module d'exploration des données permettant de visualiser les différentes métriques mises à disposition pour l'analyse de bassin versant.

"), HTML(" -

Contact : Louis Manière (CNRS UMR 5600, Environnement Ville Société) - louis.maniere@ens-lyon.fr

+

Contact : Lise Vaudor (CNRS UMR 5600, Environnement Ville Société) - lise.vaudor@ens-lyon.fr

"), tags$a( href = "https://evs-gis.github.io/mapdowebsite/", From dc396ad91e45adfa2359073854ce589192d341be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mani=C3=A8re=20Louis?= Date: Mon, 29 Jan 2024 17:49:44 +0100 Subject: [PATCH 2/5] add blue tooltip metric --- NAMESPACE | 1 + R/fct_map.R | 15 ++++++++++++--- R/mod_explore.R | 10 +++++++++- man/map_dgo_axis.Rd | 6 ++++-- 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4bb0942..4338f91 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,6 +84,7 @@ importFrom(leaflet,addWMSTiles) importFrom(leaflet,clearGroup) importFrom(leaflet,hideGroup) importFrom(leaflet,highlightOptions) +importFrom(leaflet,labelOptions) importFrom(leaflet,layersControlOptions) importFrom(leaflet,leaflet) importFrom(leaflet,leafletOutput) diff --git a/R/fct_map.R b/R/fct_map.R index d352407..1931b42 100644 --- a/R/fct_map.R +++ b/R/fct_map.R @@ -427,10 +427,11 @@ 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 tooltip_metric text with the selected metric name. #' #' @return A modified Leaflet map object with DGO axes added. #' -#' @importFrom leaflet clearGroup addPolylines highlightOptions pathOptions +#' @importFrom leaflet clearGroup addPolylines highlightOptions pathOptions labelOptions #' #' @examples #' # Create a basic Leaflet map @@ -446,11 +447,17 @@ 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, tooltip_metric = "active_channel_width") #' my_map #' #' @export -map_dgo_axis <- function(map, selected_axis, region_axis) { +map_dgo_axis <- function(map, selected_axis, region_axis, tooltip_metric) { + + tooltip_label <- NULL + if (!is.null(tooltip_metric)){ + tooltip_label <- selected_axis[[tooltip_metric]] + } + map %>% clearGroup(params_map_group()$dgo_axis) %>% clearGroup(params_map_group()$axis) %>% @@ -460,6 +467,8 @@ map_dgo_axis <- function(map, selected_axis, region_axis) { layerId = ~fid, weight = 5, color = "#ffffff00", + label = tooltip_label, + labelOptions = labelOptions(style = list("color" = "blue")), opacity = 1, highlightOptions = highlightOptions( opacity = 1, diff --git a/R/mod_explore.R b/R/mod_explore.R index 31741e0..273bdd4 100644 --- a/R/mod_explore.R +++ b/R/mod_explore.R @@ -406,10 +406,12 @@ mod_explore_server <- function(id){ mutate(measure = measure/1000) # extract axis start end point r_val$axis_start_end = data_get_axis_start_end(dgo_axis = r_val$dgo_axis) + # browser() # 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, + tooltip_metric = r_val$selected_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 +510,12 @@ mod_explore_server <- function(id){ # update profile with new metric selected if (r_val$profile_display == TRUE){ + + # 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, + tooltip_metric = r_val$selected_metric) + proxy_main_axe <- lg_profile_update_main( data = r_val$selected_axis_df, diff --git a/man/map_dgo_axis.Rd b/man/map_dgo_axis.Rd index c247dcf..5a4bdeb 100644 --- a/man/map_dgo_axis.Rd +++ b/man/map_dgo_axis.Rd @@ -4,7 +4,7 @@ \alias{map_dgo_axis} \title{Add DGO axis to a Leaflet map} \usage{ -map_dgo_axis(map, selected_axis, region_axis) +map_dgo_axis(map, selected_axis, region_axis, tooltip_metric) } \arguments{ \item{map}{A Leaflet map object.} @@ -12,6 +12,8 @@ map_dgo_axis(map, selected_axis, region_axis) \item{selected_axis}{A data frame containing selected axe to be displayed.} \item{region_axis}{A data frame containing region-specific axes to be displayed.} + +\item{tooltip_metric}{text with the selected metric name.} } \value{ A modified Leaflet map object with DGO axes added. @@ -33,7 +35,7 @@ selected_axes <- network_axis \%>\% filter(axis == 5) 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, tooltip_metric = "active_channel_width") my_map } From c3049e9d68bb88a7093147ac14a33fffe474ca88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mani=C3=A8re=20Louis?= Date: Tue, 30 Jan 2024 10:30:42 +0100 Subject: [PATCH 3/5] dgo tooltip labels from main and second metrics --- NAMESPACE | 1 - R/fct_map.R | 24 +++++++++++++++--------- R/mod_explore.R | 10 +++++++--- man/map_dgo_axis.Rd | 9 ++++++--- man/map_legend_vector_overlayer.Rd | 4 +++- 5 files changed, 31 insertions(+), 17 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4338f91..4bb0942 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,7 +84,6 @@ importFrom(leaflet,addWMSTiles) importFrom(leaflet,clearGroup) importFrom(leaflet,hideGroup) importFrom(leaflet,highlightOptions) -importFrom(leaflet,labelOptions) importFrom(leaflet,layersControlOptions) importFrom(leaflet,leaflet) importFrom(leaflet,leafletOutput) diff --git a/R/fct_map.R b/R/fct_map.R index 1931b42..5898e51 100644 --- a/R/fct_map.R +++ b/R/fct_map.R @@ -427,11 +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 tooltip_metric text with the selected metric name. +#' @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 labelOptions +#' @importFrom leaflet clearGroup addPolylines highlightOptions pathOptions +#' @importFrom htmltools HTML #' #' @examples #' # Create a basic Leaflet map @@ -447,15 +449,19 @@ 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, tooltip_metric = "active_channel_width") +#' 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, tooltip_metric) { +map_dgo_axis <- function(map, selected_axis, region_axis, main_metric, second_metric) { tooltip_label <- NULL - if (!is.null(tooltip_metric)){ - tooltip_label <- selected_axis[[tooltip_metric]] + if (!is.null(main_metric) && is.null(second_metric)){ + tooltip_label <- paste0(' ', selected_axis[[main_metric]], ' ') + } else if (!is.null(main_metric) && !is.null(second_metric)){ + tooltip_label <- paste0(' ', selected_axis[[main_metric]], '
', + ' ', selected_axis[[second_metric]], ' ') } map %>% @@ -467,8 +473,7 @@ map_dgo_axis <- function(map, selected_axis, region_axis, tooltip_metric) { layerId = ~fid, weight = 5, color = "#ffffff00", - label = tooltip_label, - labelOptions = labelOptions(style = list("color" = "blue")), + label = lapply(tooltip_label, htmltools::HTML), opacity = 1, highlightOptions = highlightOptions( opacity = 1, @@ -736,12 +741,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_explore.R b/R/mod_explore.R index 273bdd4..7ab3993 100644 --- a/R/mod_explore.R +++ b/R/mod_explore.R @@ -406,12 +406,11 @@ mod_explore_server <- function(id){ mutate(measure = measure/1000) # extract axis start end point r_val$axis_start_end = data_get_axis_start_end(dgo_axis = r_val$dgo_axis) - # browser() # 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, - tooltip_metric = r_val$selected_metric) %>% + 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 @@ -514,7 +513,7 @@ mod_explore_server <- function(id){ # 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, - tooltip_metric = r_val$selected_metric) + main_metric = r_val$selected_metric, second_metric = r_val$selected_profile_metric) proxy_main_axe <- lg_profile_update_main( @@ -604,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]], diff --git a/man/map_dgo_axis.Rd b/man/map_dgo_axis.Rd index 5a4bdeb..3638951 100644 --- a/man/map_dgo_axis.Rd +++ b/man/map_dgo_axis.Rd @@ -4,7 +4,7 @@ \alias{map_dgo_axis} \title{Add DGO axis to a Leaflet map} \usage{ -map_dgo_axis(map, selected_axis, region_axis, tooltip_metric) +map_dgo_axis(map, selected_axis, region_axis, main_metric, second_metric) } \arguments{ \item{map}{A Leaflet map object.} @@ -13,7 +13,9 @@ map_dgo_axis(map, selected_axis, region_axis, tooltip_metric) \item{region_axis}{A data frame containing region-specific axes to be displayed.} -\item{tooltip_metric}{text with the selected metric name.} +\item{main_metric}{text with the main selected metric name.} + +\item{second_metric}{text with the second axis selected metric name.} } \value{ A modified Leaflet map object with DGO axes added. @@ -35,7 +37,8 @@ selected_axes <- network_axis \%>\% filter(axis == 5) region_axes <- network_axis # Add DGO axes to the map -my_map <- map_dgo_axis(my_map, selected_axes, region_axes, tooltip_metric = "active_channel_width") +my_map <- map_dgo_axis(my_map, selected_axes, region_axes, + main_metric = "active_channel_width", second_metric = "talweg_slope") my_map } diff --git a/man/map_legend_vector_overlayer.Rd b/man/map_legend_vector_overlayer.Rd index 9061790..03565c6 100644 --- a/man/map_legend_vector_overlayer.Rd +++ b/man/map_legend_vector_overlayer.Rd @@ -8,6 +8,8 @@ map_legend_vector_overlayer(layer_label, color) } \arguments{ \item{layer_label}{A character string representing the label or name of the vector overlay layer.} + +\item{color}{text the legend marker color.} } \value{ An HTML div element representing the legend entry for the vector overlay layer. @@ -17,7 +19,7 @@ This function generates an HTML representation of a legend entry for a vector ov } \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) } From 40ab20e0274828b5137846e4fbcb02bf08acebfd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mani=C3=A8re=20Louis?= Date: Tue, 30 Jan 2024 11:08:15 +0100 Subject: [PATCH 4/5] fix tooltip label interactivity and conditions --- R/fct_map.R | 21 ++++++++++++--------- R/mod_explore.R | 16 +++++++++++----- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/R/fct_map.R b/R/fct_map.R index 5898e51..4795ef3 100644 --- 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"]] @@ -456,12 +456,15 @@ map_metric <- function(map, wms_params = params_wms()$metric, #' @export 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 <- paste0(' ', selected_axis[[main_metric]], ' ') + tooltip_label <- lapply(paste0(' ', selected_axis[[main_metric]], ' '), + htmltools::HTML) } else if (!is.null(main_metric) && !is.null(second_metric)){ - tooltip_label <- paste0(' ', selected_axis[[main_metric]], '
', - ' ', selected_axis[[second_metric]], ' ') + tooltip_label <- lapply(paste0(' ', selected_axis[[main_metric]], '
', + ' ', selected_axis[[second_metric]], ' '), + htmltools::HTML) } map %>% @@ -473,7 +476,7 @@ map_dgo_axis <- function(map, selected_axis, region_axis, main_metric, second_me layerId = ~fid, weight = 5, color = "#ffffff00", - label = lapply(tooltip_label, htmltools::HTML), + label = tooltip_label, opacity = 1, highlightOptions = highlightOptions( opacity = 1, diff --git a/R/mod_explore.R b/R/mod_explore.R index 7ab3993..8890c2c 100644 --- a/R/mod_explore.R +++ b/R/mod_explore.R @@ -510,11 +510,6 @@ mod_explore_server <- function(id){ # update profile with new metric selected if (r_val$profile_display == TRUE){ - # 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) - proxy_main_axe <- lg_profile_update_main( data = r_val$selected_axis_df, @@ -544,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]], @@ -629,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 #### From b55308b5a175477b64898b07fed00ced58f73da2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mani=C3=A8re=20Louis?= Date: Tue, 30 Jan 2024 11:11:03 +0100 Subject: [PATCH 5/5] change color legend ROE and hydro stations --- R/mod_explore.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mod_explore.R b/R/mod_explore.R index 8890c2c..057b8a9 100644 --- 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