Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Tooltip metric map #24

Merged
merged 5 commits into from
Jan 30, 2024
Merged

Tooltip metric map #24

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
26e8845
update contact documentation
LouisManiere Jan 29, 2024
dc396ad
add blue tooltip metric
LouisManiere Jan 29, 2024
c3049e9
dgo tooltip labels from main and second metrics
LouisManiere Jan 30, 2024
40ab20e
fix tooltip label interactivity and conditions
LouisManiere Jan 30, 2024
b55308b
change color legend ROE and hydro stations
LouisManiere Jan 30, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 26 additions & 8 deletions R/fct_map.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"]]
Expand Down Expand Up @@ -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
Expand All @@ -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) %>%
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/mod_documentation.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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/",
Expand Down
24 changes: 21 additions & 3 deletions R/mod_explore.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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]],
Expand Down Expand Up @@ -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]],
Expand All @@ -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 ####
Expand Down
9 changes: 7 additions & 2 deletions man/map_dgo_axis.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

4 changes: 3 additions & 1 deletion man/map_legend_vector_overlayer.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading