Hint in brilliant user interface for reference

I want to put help text for a check mark as a tooltip. In the following example, I use the shinyBS package - but I can make it work only for the header of the checkbox input group.

Any ideas how this might work after the Lernerfolg or Enthusiasmus labels?

 library(shiny) library(shinyBS) server <- function(input, output) { output$distPlot <- renderPlot({ hist(rnorm(input$obs), col = 'darkgray', border = 'white') output$rendered <- renderUI({ checkboxGroupInput("qualdim", tags$span("Auswahl der Qualitätsdimension", tipify(bsButton("pB2", "?", style = "inverse", size = "extra-small"), "Here, I can place some help")), c("Lernerfolg" = "Lernerfolg" , "Enthusiasmus" = "Enthusiasmus" ), selected = c("Lernerfolg")) }) }) } ui <- fluidPage( sidebarLayout( sidebarPanel( sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100), uiOutput("rendered") ), mainPanel(plotOutput("distPlot")) ) ) shinyApp(ui = ui, server = server) 
+6
source share
2 answers

Unfortunately, this is one of those moments when the shiny one hides most of the design, making it difficult to get what you want in the right places.

But, as in most cases, some JavaScript will do the trick. I wrote you a function that inserts bsButton in the right place and calls the shinyBS function to insert a tooltip. (I basically reconstructed what tipify and bdButton would do.) With this function, you can easily modify your tooltip without additional knowledge of JavaScript.

If you want to know more about the details, just ask in the comments.

Note. When you reference this checkbox, use its value (the value sent to input$qualdim )

 library(shiny) library(shinyBS) server <- function(input, output) { makeCheckboxTooltip <- function(checkboxValue, buttonLabel, Tooltip){ script <- tags$script(HTML(paste0(" $(document).ready(function() { var inputElements = document.getElementsByTagName('input'); for(var i = 0; i < inputElements.length; i++){ var input = inputElements[i]; if(input.getAttribute('value') == '", checkboxValue, "'){ var buttonID = 'button_' + Math.floor(Math.random()*1000); var button = document.createElement('button'); button.setAttribute('id', buttonID); button.setAttribute('type', 'button'); button.setAttribute('class', 'btn action-button btn-inverse btn-xs'); button.appendChild(document.createTextNode('", buttonLabel, "')); input.parentElement.parentElement.appendChild(button); shinyBS.addTooltip(buttonID, \"tooltip\", {\"placement\": \"bottom\", \"trigger\": \"hover\", \"title\": \"", Tooltip, "\"}) }; } }); "))) htmltools::attachDependencies(script, shinyBS:::shinyBSDep) } output$distPlot <- renderPlot({ hist(rnorm(input$obs), col = 'darkgray', border = 'white') output$rendered <- renderUI({ list( checkboxGroupInput("qualdim", tags$span("Auswahl der Qualitätsdimension", tipify(bsButton("pB2", "?", style = "inverse", size = "extra-small"), "Here, I can place some help")), choices = c("Lernerfolg" = "Lernerfolg", "Enthusiasmus" = "Enthusiasmus"), selected = c("Lernerfolg")), makeCheckboxTooltip(checkboxValue = "Lernerfolg", buttonLabel = "?", Tooltip = "Look! I can produce a tooltip!") ) }) }) } ui <- fluidPage( sidebarLayout( sidebarPanel( sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100), uiOutput("rendered") ), mainPanel(plotOutput("distPlot")) ) ) shinyApp(ui = ui, server = server) 

Edit:

ShinyBS dependencies are added, so the JavaScript API for shinyBS is loaded into WebSite. This used to happen (more or less by accident) due to another call to bsButton .

Edit Nr.2: a lot more In-Shiny

So, this JavaScript thing is pretty nice, but it is error prone and requires additional language skills from the developer.

Here I present another answer inspired by @CharlFrancoisMarais, which only works from within R and makes things more integrated than before.

Key things: the extension function for checkboxGrouInput , which allows you to add any item to each Checkbox item. There you can freely place bsButton and tooltips, as in regular markup, with support for all function arguments.

Secondly, an extension for bsButton to put it to the right. This is rather a common thing only for @CharlFrancoisMarais request.

I would advise you to carefully read the Shiny element manipulation, because it offers so many settings at the R level. I kind of went out.

Full code below:

 library(shiny) library(shinyBS) extendedCheckboxGroup <- function(..., extensions = list()) { cbg <- checkboxGroupInput(...) nExtensions <- length(extensions) nChoices <- length(cbg$children[[2]]$children[[1]]) if (nExtensions > 0 && nChoices > 0) { lapply(1:min(nExtensions, nChoices), function(i) { # For each Extension, add the element as a child (to one of the checkboxes) cbg$children[[2]]$children[[1]][[i]]$children[[2]] <<- extensions[[i]] }) } cbg } bsButtonRight <- function(...) { btn <- bsButton(...) # Directly inject the style into the shiny element. btn$attribs$style <- "float: right;" btn } server <- function(input, output) { output$distPlot <- renderPlot({ hist(rnorm(input$obs), col = 'darkgray', border = 'white') output$rendered <- renderUI({ extendedCheckboxGroup("qualdim", label = "Checkbox", choiceNames = c("cb1", "cb2"), choiceValues = c("check1", "check2"), selected = c("check2"), extensions = list( tipify(bsButtonRight("pB1", "?", style = "inverse", size = "extra-small"), "Here, I can place some help"), tipify(bsButtonRight("pB2", "?", style = "inverse", size = "extra-small"), "Here, I can place some other help") )) }) }) } ui <- fluidPage( shinyjs::useShinyjs(), tags$head(HTML("<script type='text/javascript' src='sbs/shinyBS.js'></script>")), # useShinyBS sidebarLayout( sidebarPanel( sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100), uiOutput("rendered") ), mainPanel(plotOutput("distPlot")) ) ) shinyApp(ui = ui, server = server) 
+7
source

Here's a slight change - adding tooltips only to checkboxes.

 library(shiny) library(shinyBS) server <- function(input, output) { makeCheckboxTooltip <- function(checkboxValue, buttonLabel, buttonId, Tooltip){ tags$script(HTML(paste0(" $(document).ready(function() { var inputElements = document.getElementsByTagName('input'); for(var i = 0; i < inputElements.length; i++) { var input = inputElements[i]; if(input.getAttribute('value') == '", checkboxValue, "' && input.getAttribute('value') != 'null') { var button = document.createElement('button'); button.setAttribute('id', '", buttonId, "'); button.setAttribute('type', 'button'); button.setAttribute('class', 'btn action-button btn-inverse btn-xs'); button.style.float = 'right'; button.appendChild(document.createTextNode('", buttonLabel, "')); input.parentElement.parentElement.appendChild(button); shinyBS.addTooltip('", buttonId, "', \"tooltip\", {\"placement\": \"right\", \"trigger\": \"click\", \"title\": \"", Tooltip, "\"}) }; } }); "))) } output$distPlot <- renderPlot({ hist(rnorm(input$obs), col = 'darkgray', border = 'white') output$rendered <- renderUI({ checkboxGroupInput("qualdim", label = "Checkbox", choiceNames = c("cb1", "cb2"), choiceValues = c("check1", "check2"), selected = c("check2")) }) output$tooltips <- renderUI({ list( makeCheckboxTooltip(checkboxValue = "check1", buttonLabel = "?", buttonId = "btn1", Tooltip = "tt1!"), makeCheckboxTooltip(checkboxValue = "check2", buttonLabel = "?", buttonId = "btn2", Tooltip = "tt2!") ) }) }) } ui <- fluidPage( shinyjs::useShinyjs(), tags$head(HTML("<script type='text/javascript' src='sbs/shinyBS.js'></script>")), # useShinyBS sidebarLayout( sidebarPanel( sliderInput("obs", "Number of observations:", min = 10, max = 500, value = 100), uiOutput("rendered"), uiOutput("tooltips") ), mainPanel(plotOutput("distPlot")) ) ) shinyApp(ui = ui, server = server) 
+1
source

All Articles