ShinyBS Modal в группе флажков

Я использую shinyBS::bsModal() для размещения пояснений к элементам пользовательского интерфейса. Это прекрасно работает, когда я помещаю bsButton() за заголовком флажка.

Теперь я хочу поместить его за опциями флажка. Первой подсказкой может быть этот ответ, где тот же для всплывающей подсказки сделано (но моя модификация не работает).

Минимальный пример:

library(shiny)
library(shinyBS)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("qualdim",  
                         tags$span("Chekboxoptions",   
                             bsButton("modalbt", "?", style = "inverse", size = "extra-small")),

                         c("Option_1" = "Option_1", 
                           "Option_2" = "Option_2"))
    ),

    mainPanel(
      bsModal("modalExample", "Modal", "modalbt", size = "large",
           verbatimTextOutput("helptext")))
  )
)

server <- function(input, output) {
  output$helptext <- renderText({"I can trigger a shinyBS::bsModal() from here, but I want to place two buttons behind `Option_1` and     `Option_2`" })
}

shinyApp(ui = ui, server = server)

r shiny shinybs
person sammerk    schedule 30.05.2016    source источник

Ответы (1)


arrow_upward
3
arrow_downward

bsModal работает где угодно и просто использует идентификатор кнопки в качестве триггера. Так что единственное, что вам нужно сделать, это получить подходящую кнопку внутри checkboxGroup. Из предыдущего вопроса/ответа, который вы связали, у вас уже есть функция для получения bsButton внутри группового ввода. (Просто сотрите строку, где была назначена всплывающая подсказка. Здесь это не нужно.)

Код ниже в основном копипаст сейчас. Я только что добавил некоторые дополнительные bsButton настройки, такие как размер, стиль и идентификатор (это важно! Не было важно в связанном вопросе с всплывающими подсказками!), чтобы вы могли использовать функцию более точно используйте bsButton.

library(shiny)
library(shinyBS)

makeCheckboxButton <- function(checkboxValue, buttonId, buttonLabel, size = "default", style = "default"){
    size <- switch(size, `extra-small` = "btn-xs", small = "btn-sm", 
        large = "btn-lg", "default")
    style <- paste0("btn-", style)

    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 button = document.createElement('button');
                button.setAttribute('id', '", buttonId, "');
                button.setAttribute('type', 'button');
                button.setAttribute('class', '", paste("btn action-button", style , size), "');
                button.appendChild(document.createTextNode('", buttonLabel, "'));

                input.parentElement.parentElement.appendChild(button);
             };
            }
          });
        ")))
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("qualdim", label = "Chekboxoptions", choices = c("Option_1", "Option_2")),
      makeCheckboxButton("Option_1", "modalbt", "?", size = "extra-small", style = "inverse")
    ),

    mainPanel(
      bsModal("modalExample", "Modal", "modalbt", size = "large",
           verbatimTextOutput("helptext")))
  )
)

server <- function(input, output) {
  output$helptext <- renderText({"I can trigger a shinyBS::bsModal() from here, but I want to place two buttons behind `Option_1` and     `Option_2`" })
}

shinyApp(ui = ui, server = server)
person K. Rohde    schedule 30.05.2016