shiny js: измените ярлык кнопки на основе выбора пользователя с этой кнопки

Question

Я блестящий новичок js и, похоже, в тупике с этой проблемой.

Я хочу создать выпадающую кнопку, чья метка изменяется с выбором пользователя с этой кнопки.

Следующий мой минимальный воспроизводимый код. Я схватил функцию кнопки выпадающей из этого поста: 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) 

я хотел бы ярлык по умолчанию на кнопку, чтобы быть «Вырезать таблицу с помощью» (или это может быть даже выбор «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)