Insert popify for radiobuttons options

Question

I did a popify for my radiobutton. However I would like to separate the popify in my radiobuttom options. For example, for "filter1", I would like to insert a popify for the "All properties" and other popify for "exclude properties" options. Is this possible ?? The executable code is below.

library(shinyBS)
library(shiny)

ui <- fluidPage(


  titlePanel("Old Faithful Geyser Data"),

  sidebarLayout(
    sidebarPanel(


      popify(  
        radioButtons("filter1", h3("Select properties"),
                     choices = list("All properties" = 1, 
                                    "Exclude properties" = 2),
                     selected = 1),
        title= "Select Proprierties",
        content = paste0("Filter 1 refers to.....")),

        radioButtons("filter2", h3("Select farms"),
                     choices = list("All farms" = 1, 
                                    "Exclude farms" = 2),
                     selected = 1),
       sliderInput("bins",
                    "Number of bins:",
                    min = 1,
                    max = 20,
                    value = 30)
           ),

    mainPanel(
      plotOutput("distPlot")
    )
  )
)

server <- function(input, output) {

  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

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

Thank you very much!

Answer 1

Looking at popify we see that it works only on full shiny elements, but you want to add it not to the whole element but a child HTML element of it.

addPopover seems thus to be the better option. However, we see that the function adds the popover on an HTML element given by an id. Problem is that the row where you want to have the popover does not have an id and the addPopover function does not allow for specifying the element by other means than the id.

Thus, we have to work around:

1. Use JS to add an id to the radio button rows (I use shinyjs for that).
2. Use this created id in addPopover

Note. In order to make addPopover run you need to include at least one shinyBS component. From the help file:

There must be at least one ‘shinyBS’ component in the UI of your app in order for the necessary dependencies to be loaded. Because of this, ‘addTooltip’ and ‘addPopover’ will not work if they are the only shinyBS components in your app.

library(shinyBS)
library(shiny)
library(shinyjs) ## needed to tamper with the HTML

ui <- fluidPage(
   useShinyjs(),

   titlePanel("Old Faithful Geyser Data"),

   sidebarLayout(
      sidebarPanel( 
         radioButtons("filter1", h3("Select properties"),
                      choices = list("All properties" = 1, 
                                     "Exclude properties" = 2),
                      selected = 1),
         title= "Select Proprierties",
         radioButtons("filter2", h3("Select farms"),
                      choices = list("All farms" = 1, 
                                     "Exclude farms" = 2),
                      selected = 1),
         sliderInput("bins",
                     "Number of bins:",
                     min = 1,
                     max = 20,
                     value = 30),
         ## need to include at least one bs element, adapt
         bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
                   "right", options = list(container = "body")) 

      ),

      mainPanel(
         plotOutput("distPlot")
      )
   )
)

## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
   "$('#filter1').find('.radio > label').attr('id', function(i) {",
   "return 'filter1_row_' + i})")

server <- function(input, output, session) {
  ## once the UI is loaded, call JS function and attach popover to it
   session$onFlushed(function() {
      runjs(add_id_js)
      addPopover(session, "filter1_row_0", "My Popover", "Content")

   })


   output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- faithful[, 2]
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
   })
}

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