可悲的是，这是其中一个时刻，闪亮的东西隐藏了大部分的建筑，这使得你很难把你想要的东西放到正确的地方。
但就像大多数时候一样，一些 JavaScript 可以解决问题。我给你写了一个函数，它bsButton在正确的位置插入并调用一个 shinyBS 函数来插入工具提示。（我主要是重构什么tipify和bdButton会做什么。）使用该功能，您可以轻松修改您的工具提示，而无需进一步了解 JavaScript。
如果您想了解更多详细信息，请在评论中询问。
注意：当您引用复选框时，请使用它的值（发送到的值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)
编辑：
添加了 ShinyBS 依赖项，以便将 ShinyBS 的 JavaScript API 加载到网站中。以前，这（或多或少是偶然的）是由于对bsButton.
编辑 Nr.2：更加闪亮
所以这个 JavaScript 东西很不错，但有点容易出错，并且需要开发人员有一些额外的语言技能。
在这里，我提出另一个答案，受@CharlFrancoisMarais 启发，它只在内部起作用，R并且使事情比以前更加集成。
主要内容是： 的扩展函数checkboxGrouInput，允许将任何元素添加到每个 Checkbox 元素。bsButton在那里，可以像在普通标记中一样自由放置和 工具提示，并支持所有函数参数。
第二，扩展的bsButton放置它的权利。这更像是针对@CharlFrancoisMarais 请求的自定义内容。
我建议您Shiny仔细阅读 -element 操作，因为这提供了很多R级别的自定义。我有点退出了。
完整代码如下：
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)