The problem: I am trying to add 'hover text' to the choices available in the select input/multi input function in shiny. According to a different user, ShinyBS's tooltip function is only designed for selection by id. Thus, I am trying to use something finer than that to achieve my outcome.
This is great solution that I am trying to modify. The solution involves creating a new function called selectizeInput: (according to the creator of the function)
"[] moves the choices around, renders them anew, renders them only when they are first shown and so on. A lot of things happen. This is why this solution grabs the surrounding div and listens constantly to childNodes being added."
I don't really understand a lot of what is going on with the function, but here is an example of some reproducible code. Included is the user function selectizeInput referenced above. As you can see, I am trying to use this function to add a hover text in my multiInput function. I want to to add functionality, so that when one hovers over 'group 1' the text 'group 1 definition' pops up.
I am open to using a completely different solution to add this feature!
What I have tried: Any suggestions are greatly appreciated! I would ideally use multiInput, but it selectInput with multiple set to TRUE is also a good work around. However, there are some other issues that occur when I do this.
- Once I select a choice, the labels of the remaining choices do not show. For example when I select group 1 and group 3, I can't see the label for group 2 when I hover over it.
The text box that contains the label (in the drop down) is very narrow--it's not easy to read the definition
Once selected, the definition is partially hidden
Here is my code:
library(shiny)
library(shinyBS)
selectizeTooltip <- function(id, choice, title, placement = "bottom", trigger = "hover", options = NULL){
options = shinyBS:::buildTooltipOrPopoverOptionsList(title, placement, trigger, options)
options = paste0("{'", paste(names(options), options, sep = "': '", collapse = "', '"), "'}")
bsTag <- shiny::tags$script(shiny::HTML(paste0("
$(document).ready(function() {
var opts = $.extend(", options, ", {html: true});
var selectizeParent = document.getElementById('", id, "').parentElement;
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation){
$(mutation.addedNodes).filter('div').filter(function(){return(this.getAttribute('data-value') == '", choice, "');}).each(function() {
$(this).tooltip('destroy');
$(this).tooltip(opts);
});
});
});
observer.observe(selectizeParent, { subtree: true, childList: true });
});
")))
htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
}
ui <- fluidPage(theme = shinytheme("superhero"), # shinythemes::themeSelector(), #
br(),
br(),
headerPanel(h2(" ", align = 'center')),
br(),
sidebarLayout(
sidebarPanel(
uiOutput("choose_prog"),
uiOutput("choose_name"),
br(),
selectizeTooltip(id="choose_name", choice = "group 1", title = "group 1 definition this is a long definition that does not really display well within the narrow text box", placement = "right", trigger = "hover"),
selectizeTooltip(id="choose_name", choice = "group 2", title = "group 2 definition this is another long definition. WHen group 1 and group 3 is is selected, you no longer see this definition", placement = "right", trigger = "hover"),
selectizeTooltip(id="choose_name", choice = "group 3", title = "group 3 definition this does not show if all of the other groups are selected ", placement = "right", trigger = "hover"),
),
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output) {
# Drop down selection to chose the program
output$choose_prog <- renderUI({
selectInput("program",
label = HTML('<FONT color="orange"><FONT size="4pt">Select a Program:'),
choices = c("A","B","C"))
})
# Drop down for name
output$choose_name <- renderUI({
# SelectInput works, but this only allows the selection of a SINGLE option
selectInput("names",
label = HTML('<FONT color="orange"><FONT size="4pt">Select user group of interest:'),
choices = c("group 1", "group 2", "group 3"),
multiple = T)
# multiInput("names",
# label = HTML('<FONT color="orange"><FONT size="4pt">Select user group of interest:'),
# choices = c("group 1", "group 2", "group 3"))
#
})
observeEvent(input$choose_name, {
updateSelectizeInput(session, "choose_name", choices = c("group 1", "group 2", "group 3"))
})
}
shinyApp(ui = ui, server = server)
