CODEWITHSUNDEEP
rshinyshinyjs
chungkim271
chungkim271

Reputation: 967

shiny js: change the label of a button based on the user choice from that button

I'm a shiny js newbie and seem to be at a stalemate with this issue.

I want to create a dropdown button whose label changes with the user choice from that button.

The following is my minimum reproducible code. I grabbed a dropdown button function from this post: 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)

I'd like the default label to the button to be "Cut Table by" (or it could even be the choice "B") but then when the user chooses another choice, change to that letter.

I think the part that confuses me the most is the radio button function imbedded in the drop down function, and that I somehow need to make an event with an input to the imbedded function that affects an input to the imbedding function. But perhaps the situation is simpler than it seems to me.

Thank you for your help!

Upvotes: 1

Views: 990

Answers (1)

K. Rohde
K. Rohde

Reputation: 9676

You can add any element as label in your button tag. So the easiest way would be to make the label a reactive textOutput which then can react to the chosen radioButton. This way, you don't even have to change your dropdownButton function. The additions I made are pretty straightforward. Only mind that the textOutput must have inline = TRUE in order to not have an ugly break before the caret.

I modified your given code: 

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)

Upvotes: 2

Related Questions