rshinyshinyjsshinybs

Adding tooltip to disabled button in Shiny?


In R/Shiny, I would like to add a tooltip to inform the user that a button is disabled because mandatory fields aren't completed.

I am able to get a tooltip to display using the ShinyBS package, however it does not seem to work when the button is disabled. Below is a minimum working example.

Is there an easy fix to get a tool tip to work on a disabled button in Shiny?

ui.R

library(shinyBS)
library(shiny)
library(shinyjs)


shinyUI(pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Disabled!"),
actionButton("goButton2", "Go!"),
bsTooltip("goButton", "Tooltip broken", placement = "bottom", trigger = "hover",
           options = NULL),
bsTooltip("goButton2", "Tooltip works", placement = "bottom", trigger = "hover",
           options = NULL)
),
 mainPanel(useShinyjs(),
 verbatimTextOutput("nText")
)
))

server.R

library(shiny)
library(shinyjs)
library(shinyBS)

shinyServer(function(input, output,session) {

ntext <- eventReactive(input$goButton, {
input$n
})

shinyjs::disable("goButton2")

output$nText <- renderText({
 ntext()
})
})

Solution

  • This is one way of solving your problem, by providing the title to your buttons instead:

    #rm(list=ls())
    library(shinyBS)
    library(shiny)
    library(shinyjs)
    
    ui <- pageWithSidebar(
      headerPanel("actionButton test"),
      sidebarPanel(numericInput("n", "N:", min = 0, max = 100, value = 50),
        tags$div(style="display:inline-block",title="Tooltip broken",actionButton("goButton", "Disabled!")),
        tags$div(style="display:inline-block",title="Tooltip works",actionButton("goButton2", "Go!"))    
      ),
      mainPanel(useShinyjs(),
                verbatimTextOutput("nText")
      )
    )
    
    server <- shinyServer(function(input, output,session) {
      
      ntext <- eventReactive(input$goButton, {input$n})
      shinyjs::disable("goButton2")
      output$nText <- renderText({ntext()})
      
    })
    shinyApp(ui = ui, server = server)
    

    enter image description here