Work on addressing comments, glossary #4 and tooltips #6

.gitignore

@@ -9,3 +9,6 @@
 .DS_Store
 .quarto
 tests/testthat/*.pdf
+
+# Shiny bookmarks
+shiny_bookmarks/

NEWS.md

@@ -1,6 +1,9 @@
 ## Version 0.3
 
 * Incorporated Expert-Feedback and updated the protocol with additional fields and explanations.
+* Added glossary, to be further expanded in future versions #4
+* Added tooltip to the protocol for each fields (can be toggled off) #6
+* Added a bookmark option to store the current setting of the protocol as server id (experimental)
 
 ## Version 0.2
 

R/app_server.R

@@ -7,6 +7,13 @@ app_server <- function(input, output, session) {
   # Your application server logic
   sever::sever()
 
+  # Add bookmark button to top
+  # NOTE: For URL see also https://stackoverflow.com/questions/58396680/how-to-extract-the-url-from-the-shiny-bookmark-button-and-create-my-own-action-b
+  shiny::enableBookmarking(store = "server")
+  shiny::observeEvent(input$bookmark, {
+    session$doBookmark()
+  })
+
   # fake reload at start
   shiny::observeEvent(input$reload, {
     session$reload()
@@ -46,42 +53,20 @@ app_server <- function(input, output, session) {
   })
   # ---------------------------------------------------------------------------
 
-  # Add Help popups
-  # add_protocol_help(session)
-  shiny::observeEvent(input$help_switch, {
-
-    # Load the protocol within the package
-    pp <- load_protocol()[-1]
-
-      # Loop over each group and element
-      for(gr in names(pp)){
-        sub <- pp[[gr]]
-
-        for(k in names(sub)){
-          subs <- sub[[k]]
-          # Only add if pophelp has been set
-          if("pophelp" %in% names(subs)){
-
-            if(input$help_switch){
-              print(subs[['render-id']])
-              # Now add the popovers
-              bs4Dash::addPopover(
-                id = subs[['render-id']],
-                options = list(
-                  content = subs[['popexample']],
-                  title = "Example",
-                  placement = "top",
-                  trigger = "focus" # click | hover | focus | manual.
-                )
-              )
-            } else {
-              bs4Dash::removePopover(id = subs[['render-id']])
-            }
-          }
-        }
-    }
-
-  })
+  # Add Help popups for every entry
+  # Add Tooltips for each element
+  # for(n in names(protocol)){
+  #   sub <- protocol[[n]]
+  #   bs4Dash::addPopover(
+  #     id = sub['render-id'],
+  #     options = list(
+  #       content = sub$popexample,
+  #       title = sub$question,
+  #       placement = "auto",
+  #       trigger = "hover"
+  #     )
+  #   )
+  # }
 
   # title page ----------------------------------------------------------------
   # Adding module server code

R/app_ui.R

@@ -19,7 +19,7 @@ app_ui <- function(request) {
       dark = FALSE,
       scrollToTop = TRUE,
       fullscreen = FALSE,
-      help = FALSE, # Default enable tooltips
+      help = TRUE, # Default enable tooltips
       # controlbar = bs4Dash::dashboardControlbar(),
       # Define header and footer
       header = bs4Dash::dashboardHeader(
@@ -33,7 +33,18 @@ app_ui <- function(request) {
         status = "white",
         border = TRUE,
         compact = FALSE,
-        leftUi = NULL, rightUi = NULL
+        leftUi = NULL, rightUi = NULL,
+        shiny::div(style="position:relative; left:calc(65%);",
+                   shinyWidgets::actionBttn(
+                     inputId = "bookmark",
+                     label = "Save settings",
+                     style = "material-flat",
+                     color = "default",
+                     size = "xs",
+                     icon = shiny::icon("link", lib = "glyphicon")
+                   )
+                   # shiny::bookmarkButton(label = , id = "bookmark")
+        )
         ),
       footer = bs4Dash::dashboardFooter(
         fixed = FALSE,

R/mod_Context.R

@@ -269,6 +269,9 @@ mod_Context_server <- function(id, results, parentsession){
   shiny::moduleServer( id, function(input, output, session){
     ns <- session$ns
 
+    # Get protocol
+    protocol <- load_protocol()$context # Get all overview UI elements
+
     # Get all parameters
     ids <- get_protocol_ids(group = "context")
     shiny::observe({
@@ -287,6 +290,14 @@ mod_Context_server <- function(id, results, parentsession){
       }
     })
     # ----- #
+
+    # --- #
+    # Add Tooltips for each element
+    shiny::observeEvent(parentsession$input$help_switch,{
+      # Enable tooltips if set
+      add_protocol_help(parentsession, protocol, type = "popover")
+    })
+    # --- #
   })
 }
 

R/mod_Design.R

@@ -75,6 +75,10 @@ mod_Design_ui <- function(id){
                      shiny::p("Does the study follow an analytical framework, either explicitly
                        defined within the study or through a reference to previous
                        work? This could for example also be a specific planning protocol."),
+                     shiny::p("Example framework references:"),
+                     shiny::p("Pressey, R. L., & Bottrill, M. C. (2009). Approaches to landscape-and seascape-scale conservation planning: convergence, contrasts and challenges. Oryx, 43(4), 464-475."),
+                     shiny::p("Álvarez-Romero, J. G., Adams, V. M., Pressey, R. L., Douglas, M., Dale, A. P., Augé, A. A., ... & Perdrisat, I. (2015). Integrated cross-realm planning: A decision-makers' perspective. Biological Conservation, 191, 799-808."),
+                     shiny::p("Niemiec, R. M., Gruby, R., Quartuch, M., Cavaliere, C. T., Teel, T. L., Crooks, K., ... & Manfredo, M. (2021). Integrating social science into conservation planning. Biological Conservation, 262, 109298."),
                      shinyWidgets::pickerInput(
                        inputId = ns("studyframework"),
                        label = "Analytical Framework",
@@ -131,7 +135,7 @@ mod_Design_ui <- function(id){
                       conservation management (e.g. Protected areas)"),
                     shiny::selectizeInput(inputId = ns("studypurpose"),
                                           label = "Identify or add a primary purpose",
-                                          choices = c("","Area-based expansion", "Management improvement",
+                                          choices = c("","Area-based allocation", "Management improvement",
                                                       "Action-based planning", "Monitoring and evaluation",
                                                       "Land-use allocation"),
                                           multiple = FALSE,
@@ -332,6 +336,8 @@ mod_Design_server <- function(id, results, parentsession){
     ns <- session$ns
 
     # Study design page --------------------------------------------------------------
+    # Get protocol
+    protocol <- load_protocol()$design # Get all overview UI elements
 
     # Load all parameters and add them to the reactive result container
     # Upon change
@@ -342,6 +348,14 @@ mod_Design_server <- function(id, results, parentsession){
       }
     })
 
+    # --- #
+    # Add Tooltips for each element
+    shiny::observeEvent(parentsession$input$help_switch,{
+      # Enable tooltips if set
+      add_protocol_help(parentsession, protocol, type = "popover")
+    })
+    # --- #
+
   })
 }
 

R/mod_Glossary.R

@@ -18,27 +18,16 @@ mod_Glossary_ui <- function(id){
       shiny::fluidRow(
         shiny::column(width = 2),
         shiny::column(width = 12,
-                      bs4Dash::tabsetPanel(
-                        id = ns("Glossary"),
-                        type = "pills",
-                        vertical = FALSE,
-                        selected = "Glossary",
-                        # News panel
-                        shiny::tabPanel(
+                        bs4Dash::box(
                           title = "Glossary",
-                          shiny::br(),
-                          bs4Dash::box(
-                            title = "Glossary",
-                            status = "primary",
-                            solidHeader = TRUE,
-                            collapsed = FALSE,
-                            width = 12,
-                            DT::dataTableOutput('glossary_table')
-                          )
+                          status = "primary",
+                          solidHeader = TRUE,
+                          collapsed = FALSE,
+                          width = 12,
+                          DT::DTOutput(outputId = ns('glossary_table'))
                         )
                       )
-        )
-      )
+          )
     ) # End fluidpage
   ) # End of tabItem
 }
@@ -55,7 +44,9 @@ mod_Glossary_server <- function(id){
                          package = "ODPSCP",
                          mustWork = TRUE)
     output$glossary_table <- DT::renderDataTable(
-      read.csv(ppath)
+      read.csv(ppath, sep = ",",header = TRUE) |>
+        DT::datatable(filter = "none", rownames = FALSE,
+                      editable = FALSE)
     )
   })
 }

R/mod_Overview.R

@@ -28,7 +28,9 @@ mod_Overview_ui <- function(id){
             intend to both uniquely identify the study, provide necessary information
             on the availability of code or data and broadly categorizes any and all studies
             based on the listed properties.
-            "
+            ",
+            shiny::br(),
+            shiny::strong("By default example popups are shown for text fields, which can be disabled through the questionmark at the top bar.")
           ),
           shiny::hr()
         )
@@ -48,7 +50,7 @@ mod_Overview_ui <- function(id){
             collapsed = FALSE,
             collapsible = TRUE,
             shiny::textAreaInput(inputId = ns("studyname"),
-                                  label = shiny::div("Study name", "  ", shiny::icon("info") ),
+                                  label = shiny::div("Study name"),
                                   placeholder = 'What is the title of the conducted study?',
                                   height = "45px", width = "100%", resize = "none"),
           # Authors
@@ -341,7 +343,7 @@ mod_Overview_server <- function(id, results, parentsession){
     ns <- session$ns
 
     #### Dynamic rendering of UI Elements ####
-    # protocol <- load_protocol()$overview # Get all overview UI elements
+    protocol <- load_protocol()$overview # Get all overview UI elements
     # output$Overview_UI = render_protocol("Overview", protocol)
     # -------------------------------------------
 
@@ -406,6 +408,28 @@ mod_Overview_server <- function(id, results, parentsession){
     })
     # ----- #
 
+    # Shiny feedback for mandatory fields
+    # FIXME: This horribly messes up the format
+    # shiny::observeEvent(input$studyname, {
+    #   if(input$studyname=="") {
+    #     shinyFeedback::showFeedback(
+    #       "studyname",
+    #       text = "This field is mandatory",
+    #       color = "#d9534f",
+    #       icon = shiny::icon("exclamation-sign", lib="glyphicon")
+    #     )
+    #   } else {
+    #     shinyFeedback::hideFeedback("studyname")
+    #   }
+    # })
+
+    # --- #
+    # Add Tooltips for each element
+    shiny::observeEvent(parentsession$input$help_switch,{
+      # Enable tooltips if set
+      add_protocol_help(parentsession, protocol, type = "popover")
+    })
+    # --- #
 
     # Clear all
     shiny::observeEvent(input$reset, {

R/mod_Prioritization.R

@@ -126,18 +126,19 @@ mod_Prioritization_ui <- function(id){
                        collapsible = FALSE,
                        shiny::p("Not always is there a single solution to the prioritization process or
                          where only single prioritizations run.",
-                         "For example, the selection frequency across multiple iterations
-                         or prioritization runs could be used to identify the set of
-                         final 'priority' areas.",
+                         "Besides factors directly included in the prioritization,
+                         it is also common to consider external or auxillary datasets,
+                         selection frequency across multiple iterations, or
+                         prioritization runs to identify a set of final 'priority' areas
+                         or actions.",
                          "Here we record how the final priorities (those reported in the study) were obtained."),
                        shinyWidgets::pickerInput(
                          inputId = ns("identsolution"),
-                         label = "Identification of solutions",
-                         choices = c("","Budgets reached or costs exceeded",
-                                     "Targets achieved",
+                         label = "Identification of priorities",
+                         choices = c("Single solution",
                                      "Selection frequency",
-                                     "External indicator",
                                      "Overlays",
+                                     "External indicator",
                                      "Other")
                        ),
                        shiny::conditionalPanel(
@@ -230,6 +231,9 @@ mod_Prioritization_server <- function(id, results, parentsession){
   shiny::moduleServer( id, function(input, output, session){
     ns <- session$ns
 
+    # Get full protocol
+    protocol <- load_protocol()$prioritization # Get all overview UI elements
+
     ids <- get_protocol_ids(group = "prioritization")
     shiny::observe({
       for(id in ids){
@@ -277,6 +281,13 @@ mod_Prioritization_server <- function(id, results, parentsession){
       indicators(modified_data)
     })
 
+    # --- #
+    # Add Tooltips for each element
+    shiny::observeEvent(parentsession$input$help_switch,{
+      # Enable tooltips if set
+      add_protocol_help(parentsession, protocol, type = "popover")
+    })
+    # --- #
   })
 }