1

I would like to add a tooltip to a valueBox subtitle, but I have an issue doing this - specifically when the valueBox has been generated in the server.

In my example you can see for Value 2, I generate the valueBox in the UI, wrap the subtitle in a div, and successfully add a tooltip. But in Value 1, I generate the valueBox in the server, try to use the same approach of wrapping the subtitle in div, but no tooltip appears!


# Load required packages
library(shinydashboard)
library(shinyBS)

# Define UI
ui <- dashboardPage(
  dashboardHeader(title = "Simple Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow(
                div(id = "box1",
                    box(
                  title = "Value 1",
                  valueBoxOutput("valueBox1"),
                  div(id = "textbox1", textOutput("text1"))
                )),
                bsTooltip(id = "valbox1", "Not working"),
                bsTooltip(id = "textbox1", "Working as expected"),
              ),
              fluidRow(
                div(id = "box2",
                    box(
                      title = "Value 2",
                      valueBox(32,
                               div(id = "valbox2", "Value 2")),
                      div(id = "textbox2", textOutput("text2"))

                    )),
                bsTooltip(id = "valbox2", "Working as expected"),
                bsTooltip(id = "textbox2", "Working as expected"),
                
              ),
              fluidRow(
                box(
                  actionButton("testButton", "TEST")
                )
              ),
              bsTooltip(id = "testButton", "Working as expected")
      )
    )
  )
)

# Define server
server <- function(input, output, session) {
  # Generate dummy data
  data <- data.frame(
    Value1 = sample(1:100, 1)
  )
  
  # Update value boxes when the action button is clicked
  observeEvent(input$testButton, {
    data$Value1 <- sample(1:100, 1)
    output$valueBox1 <- renderValueBox({
      valueBox(data$Value1,
               div(id = "valbox1", "Value 1"))
    })
    output$text1 <- renderText({
      "More info on Value 1"
    })
  })
  
  output$text2 <- renderText({
    "More info on Value 2"
  })
}

# Run the app
shinyApp(ui = ui, server = server)

I am unclear why adding the div() wrapper to the subtitle within the server is not working, when it works perfectly when I use this approach to add a wrapper in the UI.

I've already reviewed this question which shows how to add a tooltip to the entire valuebox, rather than specifically the subtitle, which is my issue.

Any help gladly received! My full application requires me to dynamically generate the valueBoxes in the server, because they can differ in number and content depending on user input - hence my need to generate in the server.

Cath
  • 57
  • 4

1 Answers1

3

One way to overcome your issue is to use renderUI to output valueBoxOutput() on the server side. Try this

# Load required packages
library(shinydashboard)
library(shinyBS)

# Define UI
ui <- dashboardPage(
  dashboardHeader(title = "Simple Dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "dashboard",
              fluidRow( uiOutput("v1")
                # div(id = "box1",
                #     box(
                #       title = "Value 1",
                #       valueBoxOutput("valueBox1"),
                #       div(id = "textbox1", textOutput("text1"))
                #     )),
                # bsTooltip(id = "valbox1", "Not working"),
                # bsTooltip(id = "textbox1", "Working as expected")
              ),
              fluidRow(
                div(id = "box2",
                    box(
                      title = "Value 2",
                      valueBox(32,
                               div(id = "valbox2", "Value 2")),
                      div(id = "textbox2", textOutput("text2"))
                      
                    )),
                bsTooltip(id = "valbox2", "Working as expected"),
                bsTooltip(id = "textbox2", "Working as expected")
                
              ),
              fluidRow(
                box(
                  actionButton("testButton", "TEST")
                )
              ),
              bsTooltip(id = "testButton", "Working as expected")
      )
    )
  )
)

# Define server
server <- function(input, output, session) {
  # Generate dummy data
  myvalue <- eventReactive(input$testButton, {
    sample(1:100, 1)
  })
  
  output$valueBox1 <- renderValueBox({
    valueBox(myvalue(), 
             div(id = "valbox1", "Value 1"))
  })
  
  output$v1 <- renderUI({
    req(myvalue())
    tagList(
      div(id = "box1",
          box(
            title = "Value 1",
            valueBoxOutput("valueBox1"),
            div(id = "textbox1", textOutput("text1"))
          )),
      bsTooltip(id = "valbox1", "Working as expected?"),
      bsTooltip(id = "textbox1", "Working as expected")
    )
  })
  output$text1 <- renderText({
    "More info on Value 1"
  })
  output$text2 <- renderText({
    "More info on Value 2"
  })
}

# Run the app
shinyApp(ui = ui, server = server)
YBS
  • 19,324
  • 2
  • 9
  • 27
  • Yes!!! Thank you. Any ideas why it doesn't work to have `BSTooltip` in the UI and the div() wrapper in the server? I'm wondering if it could be because `bsTooltip` is executed first in the UI, _before_ the `div(valuebox)` code has been executed... – Cath Jul 21 '23 at 09:01
  • 1
    Yes, that is most likely the reason. – YBS Jul 21 '23 at 12:26