Merge pull request #27 from EVS-GIS/cross_section

Cross section
EVS-GIS · Feb 1, 2024 · 48c28eb · 48c28eb
2 parents 74aba0d + 9fb2e8b
commit 48c28eb
Show file tree

Hide file tree

Showing 5 changed files with 24 additions and 14 deletions.
diff --git a/R/fct_cr_profile.R b/R/fct_cr_profile.R
@@ -42,14 +42,16 @@ cr_profile_empty <- function() {
 #' @export
 cr_section_main <- function(data){
   section <- plot_ly(data = data, x = ~distance, y = ~profile, type = 'scatter',
-                     yaxis = 'y1', key = data$fid, # the "id" column for hover text
-                     mode = 'line', fill = 'tozeroy', fillcolor = '#B0B0B0',
-                     line = list(color = '#2C2C2C'), name = "elevation") %>%
+                     yaxis = 'y1', key = data$id, # the "id" column for hover text
+                     mode = 'lines+markers', fill = 'tozeroy', fillcolor = '#B0B0B0',
+                     line = list(color = '#2C2C2C'), marker = list(opacity=0),
+                     name = "elevation") %>%
     layout(yaxis = list(title = "Elévation (m)",
                         range = c(min(data$profile, na.rm = TRUE), max(data$profile, na.rm = TRUE))),
            xaxis = list(title = "Distance au talweg (m)"),
            margin = list(l = 50, r = 30, t = 70, b = 70),
            title= "Profil transversal médian",
+           hovermode = "x unified",
            annotations = list(
              list(
                text = "Rive gauche", x = 0, y = 1.1,

diff --git a/R/fct_data.R b/R/fct_data.R
@@ -339,7 +339,7 @@ data_get_station_hubeau <- function(selected_region_id){
 #'
 #' @importFrom glue glue
 #' @importFrom DBI dbGetQuery
-#' @importFrom dplyr arrange
+#' @importFrom dplyr arrange mutate
 #'
 #' @return data.frame
 #' @export
@@ -360,6 +360,7 @@ data_get_elevation_profiles <- function(selected_dgo_fid){
                       WHERE hydro_swaths_gid = {selected_dgo_fid}")
 
   data <- DBI::dbGetQuery(conn = db_con(), statement = query) %>%
-    arrange(distance)
+    arrange(distance) %>%
+    mutate(profile = round(profile, digits = 2))
   return(data)
 }
diff --git a/R/fct_lg_profile.R b/R/fct_lg_profile.R
@@ -188,12 +188,7 @@ lg_profile_main <- function(data, y, y_label, y_label_category) {
       legend = list(orientation = 'h'),
       hovermode = "x unified",
       shapes = list(lg_vertical_line(2.5)),
-      margin = list(
-        t = 20,
-        b = 10,
-        l = 50,
-        r = 80  # create space for the second y-axis title
-      )
+      margin = list(t = 20, b = 10, l = 50, r = 80)  # create space for the second y-axis title
     )
   return(plot)
 }

diff --git a/R/globals.R b/R/globals.R
@@ -18,5 +18,5 @@ globalVariables(unique(c(
   # mod_explore_server : <anonymous>:
   "fid", "measure", "axis", "cdbh", "click", "gid",
   # data_get_elevation_profiles:
-  "distance"
+  "distance", "profile"
 )))
diff --git a/R/mod_explore.R b/R/mod_explore.R
@@ -12,6 +12,8 @@
 #' @import shiny
 #' @importFrom shinyjs useShinyjs
 #' @importFrom shinycssloaders withSpinner
+#' @importFrom bslib popover
+#' @importFrom bsicons bs_icon
 #'
 mod_explore_ui <- function(id){
   ns <- NS(id)
@@ -74,7 +76,18 @@ mod_explore_ui <- function(id){
               )
           ), # tabPanel
           tabPanel(
-            title = "Profil en travers",
+            title = div("Profil en travers",
+                        span(
+                          style = "display: inline; align-items: center",
+                          popover(
+                            trigger = bs_icon("info-circle"),
+                            "Profil transversal médian correspondant à la
+                            médiane des valeurs des transects réalisées tout les
+                            10m sur le fond de vallée du tronçon sélectionné",
+                            placement = "right",
+                            id = "popover_cross_section"
+                          )
+                        )),
             div(
               fluidRow(
                 column(width = 12,
@@ -523,7 +536,6 @@ mod_explore_server <- function(id){
         leafletProxy("exploremap") %>%
           map_dgo_cross_section(selected_dgo = r_val$data_dgo_clicked)
       }
-
     })
 
     ### EVENT METRIC ####