Question

我是一个闪亮的新手，似乎与这个问题陷入僵局。

我想创建一个下拉按钮，其标签会随着该按钮的用户选择而变化。

以下是我的最低可重复代码。我从这篇文章中抓取了一个下拉按钮功能：drop-down checkbox input in shiny：

library(shiny)
library(shinyjs)

dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
    status <- match.arg(status)
    # dropdown button content
    html_ul <- list(
        class = "dropdown-menu",
        style = if (is.null(width)) 
            paste0("width: 375px; overflow-y:scroll; max-height: 300px"), # width: validateCssUnit(width)
        lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # dropdown button apparence
    html_button <- list(
        class = paste0("btn btn-", status," dropdown-toggle"),
        type = "button", 
        `data-toggle` = "dropdown"
    )
    html_button <- c(html_button, list(label))
    html_button <- c(html_button, list(tags$span(class = "caret")))

    # final result
    tags$div(
        class = "dropdown",
        do.call(tags$button, html_button),
        do.call(tags$ul, html_ul),
        tags$script(
            "$('.dropdown-menu').click(function(e) {
            e.stopPropagation();
            });")
    )
}

ui <- fluidPage(
  uiOutput("button")
)

server <- function(input, output) {
  output$button <- renderUI({
    list(
      useShinyjs(),
      dropdownButton(label = "Cut Table By:", status = "default",
        radioButtons("letters", 
          NULL, 
          choices = c("A", "B", "C", "D", "E"),
          selected = "B")
      )
    )
  }) 
}

shinyApp(ui, server)

我希望按钮的默认标签是“Cut Table by”（或者甚至可以选择“B”）但是当用户选择其他选项时，请更改为该字母。

我认为让我最困惑的部分是嵌入在下拉功能中的单选按钮功能，而且我不知何故需要通过嵌入函数的输入来创建一个影响嵌入函数输入的事件。但也许情况比我看起来更简单。

感谢您的帮助！

Answer 1

您可以在label标记中添加任意元素button。因此，最简单的方法是使标签成为反应性textOutput，然后可以对所选的radioButton做出反应。这样，您甚至不必更改dropdownButton功能。我所做的补充非常简单。请注意，textOutput必须inline = TRUE才能在插入符号之前没有一个难看的中断。

我修改了你给定的代码：

library(shiny)
library(shinyjs)

dropdownButton <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
    status <- match.arg(status)
    # dropdown button content
    html_ul <- list(
        class = "dropdown-menu",
        style = if (is.null(width)) 
            paste0("width: 375px; overflow-y:scroll; max-height: 300px"), # width: validateCssUnit(width)
        lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;")
    )
    # dropdown button apparence
    html_button <- list(
        class = paste0("btn btn-", status," dropdown-toggle"),
        type = "button", 
        `data-toggle` = "dropdown"
    )
    html_button <- c(html_button, list(label))
    html_button <- c(html_button, list(tags$span(class = "caret")))

    # final result
    tags$div(
        class = "dropdown",
        do.call(tags$button, html_button),
        do.call(tags$ul, html_ul),
        tags$script(
            "$('.dropdown-menu').click(function(e) {
            e.stopPropagation();
            });")
    )
}

ui <- fluidPage(
  uiOutput("button")
)

server <- function(input, output) {
  output$button <- renderUI({
    list(
      useShinyjs(),
      dropdownButton(label = textOutput("labels", inline = TRUE), status = "default",
        radioButtons("letters", 
          NULL, 
          choices = c("A", "B", "C", "D", "E"),
          selected = "B")
      )
    )
  }) 

  output$labels <- renderText(paste("Cut Table By:", input$letters))
}

shinyApp(ui, server)

闪亮的js：根据该按钮的用户选择更改按钮的标签

1 个答案: