Search code examples
rtwitter-bootstrapshinyshinybs

add popovers to shiny app?


I would like to add a (?) next to the title of a widget so that the user can hover or click it and get extra information and a link they can click.

This is what I have right now:

## app.R ##
library(shiny)
library(shinydashboard)
library(shinyBS)
# Header
header <- dashboardHeader()
# Sidebar
sidebar <- dashboardSidebar(fileInput("chosenfile", label = h4("File input"), 
                                      accept = ".csv"),
                            bsButton("q1", label = "", icon = icon("question"),
                                     style = "info", size = "extra-small"),
                            bsPopover(id = "q1", title = "Tidy data",
                                      content = paste0("You should read the ", 
                                                       a("tidy data paper", 
                                                         href = "http://vita.had.co.nz/papers/tidy-data.pdf",
                                                         target="_blank")),
                                      placement = "right", 
                                      trigger = "click", 
                                      options = list(container = "body")
                                      )
                            )
# Body
body <- dashboardBody()
# ui
ui <- dashboardPage(header, sidebar, body)
# server
server <- function(input, output) {

}
# run
shinyApp(ui, server)

popover

But it is far from perfect. For example the placement of the (?) is not next to "File input" and to close the popover you have to click the question mark again instead of having an (x) in the popover.


Solution

  • this answer is probably not what you initially wanted, but it could still be working for you.

    You said you wanted the tooltip question mark next to the label, so I put it into the label. With the correct alignment. Second, you wanted the tooltip not to be open until the button is clicked again, because this is irritating. The popover option "focus" then might be the right thing for you.

    ## app.R ##
    library(shiny)
    library(shinydashboard)
    library(shinyBS)
    # Header
    header <- dashboardHeader()
    # Sidebar
    sidebar <- dashboardSidebar(
      fileInput("chosenfile", 
        label = h4("File input ",
                  tags$style(type = "text/css", "#q1 {vertical-align: top;}"),
                  bsButton("q1", label = "", icon = icon("question"), style = "info", size = "extra-small")
                ),
        accept = ".csv"),
      bsPopover(id = "q1", title = "Tidy data",
        content = paste0("You should read the ", 
                    a("tidy data paper", 
                      href = "http://vita.had.co.nz/papers/tidy-data.pdf",
                      target="_blank")
                    ),
        placement = "right", 
        trigger = "focus", 
        options = list(container = "body")
      )
    )
    # Body
    body <- dashboardBody()
    # ui
    ui <- dashboardPage(header, sidebar, body)
    # server
    server <- function(input, output) {}
    # run
    shinyApp(ui, server)