1

私はピカピカの js 初心者で、この問題で膠着状態にあるようです。

そのボタンからのユーザーの選択でラベルが変わるドロップダウンボタンを作成したいと思います。

以下は、私の最小限の再現可能なコードです。私はこの投稿からドロップダウンボタン機能をつかみました:光沢のあるドロップダウンチェックボックス入力:

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」にすることもできます) にしたいのですが、ユーザーが別の選択肢を選択すると、その文字に変更されます。

私を最も混乱させる部分は、ドロップダウン関数に埋め込まれたラジオボタン機能であり、組み込み関数への入力に影響を与える組み込み関数への入力で何らかのイベントを作成する必要があると思います。しかし、おそらく状況は私が思っているよりも単純です。

ご協力ありがとうございました！

4

1 に答える 1

2

タグのように任意の要素を追加でき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)
于 2016-07-13T17:31:38.280 に答える