最初の答え: radioButtons のツールチップの作成
遅い答えですが、ここにあります:
ご覧のとおり、shinyBS のツールチップ機能は ID による選択のみを目的として設計されています。それよりもはるかに細かいものが必要なため、新しい関数を作成して、より粗い関数を置き換える必要がありbsTooltip
ます。
新しい関数が呼び出されradioTooltip
、基本的に からのぼったくりですbsTooltip
。もう 1 つの引数、つまりツールチップを割り当てたい の が必要ですchoice
。radioButton
これにより、より細かい選択が可能になります。違いは、ドキュメント上で要素を選択する方法です。JavaScript の詳細にあまり踏み込まずに、指定された Id を持つ要素を選択し、指定されradioButton
choice
た (内部のもの、つまり で取得する値input$radioButtonId
) を保持します。
以下のコード。試してみることをお勧めします。
library(shiny)
library(shinyBS)
radioTooltip <- 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() {
setTimeout(function() {
$('input', $('#", id, "')).each(function(){
if(this.getAttribute('value') == '", choice, "') {
opts = $.extend(", options, ", {html: true});
$(this.parentElement).tooltip('destroy');
$(this.parentElement).tooltip(opts);
}
})
}, 500)
});
")))
htmltools::attachDependencies(bsTag, shinyBS:::shinyBSDep)
}
ui <- shinyUI(
fluidPage(
fluidRow(
column(3,
radioButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C"))
),
radioTooltip(id = "radioSelection", choice = "A", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
radioTooltip(id = "radioSelection", choice = "B", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
radioTooltip(id = "radioSelection", choice = "C", title = "Button 3 Explanation", placement = "right", trigger = "hover"),
column(9,'Plot')
)
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
楽しむ!
編集: selectInput/selectizeInput のツールチップの作成
selectInput
少しだけ変更することはできませんが、まったく新しい機能が必要です。理由は主に一つ。radioButtons
すべての選択肢をはっきりと見えるようにし、選択肢をselectizeInput
移動したり、新たにレンダリングしたり、最初に表示されたときにのみレンダリングしたりします。多くのことが起こります。これが、このソリューションが周囲をつかみ、追加されるのdiv
を常にリッスンする理由です。childNodes
残りは、(できれば効率的な) フィルタリングです。
以下のコード例:
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 <- shinyUI(
fluidPage(
actionButton("but", "Change choices!"),
selectizeInput(inputId = "lala", label = "Label!", choices = LETTERS),
selectizeTooltip(id = "lala", choice = "c", title = "Tooltip for c", placement = "right"),
selectizeTooltip(id = "lala", choice = "C", title = "Tooltip for C", placement = "right"),
selectizeTooltip(id = "lala", choice = "F", title = "Tooltip for F", placement = "right")
)
)
server <- function(input, output, session){
observeEvent(input$but, {
updateSelectizeInput(session, "lala", choices = c("C", letters))
})
}
shinyApp(ui, server)
ツールチップも存続updateSelectizeInput
し、最初は存在しない選択肢のツールチップが存在する可能性があることに注意してください。
人々が興味を持っている場合は、shinyBS の人たちに機能リクエストを送信して、これを彼らの仕事に含めることができます。