Реактивные радиокнопки с всплывающими подсказками в блестящем

Я хочу создать radioButtons виджет с всплывающей подсказкой shinyBS, Чего я хочу добиться - это создать один виджет с 3 кнопками с различной информацией в tooltip, На основе этого решения было создано 3 отдельных переключателя с разными значениями идентификаторов. Можно ли сделать то же самое, но с одним радио-виджетом с 3 кнопками (т.е. с одним значением id)?

library(shiny)
library(shinyBS)

ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
             HTML("<div class='container'><br>
                  <h1>Test</h1>
                  <div>
                  <label id='radio_venue_1'> 
                  <input type='radio' value='1' role='button'> button 1 
                  </label>
                  </div>
                  <div>
                  <label id='radio_venue_2'>
                  <input type='radio' value='2' role='button'> button 2
                  </label>
                  </div>
                  <div>
                  <label id='radio_venue_3'>
                  <input type='radio' value='3' role='button'> button 3
                  </label>
                  </div>
                  </div>")), 
      bsTooltip(id = "radio_venue_1", title = "Button 1 Explanation", placement = "right", trigger = "hover"),
      bsTooltip(id = "radio_venue_2", title = "Button 2 Explanation", placement = "right", trigger = "hover"),
      bsTooltip(id = "radio_venue_3", title = "Button 3 Explanation", placement = "right", trigger = "hover"),
      column(9,'Plot')
      )
    )
  )

server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
Источник

2 ответа

Решение

Начальный ответ: создание всплывающих подсказок для кнопок радио

Поздний ответ, но здесь это идет:

Как вы уже видели, функция подсказок блестящей BS предназначена только для выбора по идентификатору. Вы хотите что-то намного более прекрасное, чем это, поэтому нам нужно создать новую функцию, чтобы заменить более грубую bsTooltip,

Новая функция называется radioTooltip и в основном грабеж из bsTooltip, Требуется еще один аргумент, а именно choice из radioButton Вы хотите, чтобы подсказка была назначена. Это позволяет более точный выбор. Разница заключается в способе выбора элемента в документе. Не вдаваясь в подробности JavaScript, мы выбираем элемент с заданным идентификатором и сохраняем предоставленный radioButtonchoice (внутренний, так что значение, которое вы получите с 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 и могут быть подсказки для выбора, который изначально не существует.

Если кому-то это интересно, я мог бы отправить запрос на добавление функций парням из "BSBS ", чтобы они могли включить это в свою работу.

Источник

Вы можете использовать jQuery, чтобы добавить id приписать радио-кнопки:

library(shiny)
library(shinyBS)

js <- '$("#radioSelection :input").each(function() {
    $(this).attr("id", "radio_" + $(this).val());
});'

ui <- shinyUI(
  fluidPage(
    fluidRow(
      column(3,
             radioButtons("radioSelection", label = "So many options!", choices = c("A", "B", "C"))
      ),
      tags$script(js),
      bsTooltip("radio_A", title="Tooltip for A"),
      bsTooltip("radio_B", title="Tooltip for B"),
      bsTooltip("radio_C", title="Tooltip for C"),
      column(9,'Plot')
    )
  )
)

server <- function(input, output, session) {}

runApp(list(ui = ui, server = server), launch.browser = TRUE)
Источник
Другие вопросы по тегам