rshinylapplystylingaction-button

Styling shiny action buttons with variable names created from lapply functions and user input


I have a number input that creates a certain number of text boxes and color selection menus, depending on the number chosen by the user. This also creates a certain number of action buttons. What I want to do is have the buttons be updated based on the condition names that are typed into the text boxes, and the background colors of the buttons be the colors that are selected by the user in the colourPicker.

Here is the bare-bones version of my best attempt for reproducibility purposes (the real thing looks sexier):

library(shiny)
library(shinythemes)
library(sortable)
library(colourpicker)
library(glue)

ui = fluidPage(
  numericInput("num_conds", 
                     label = h3("Enter the number of treatments/ conditions"),
                     min = 1,
                     max = 20,
                     value = 1),

  uiOutput("boxes_conds"),
  uiOutput("cond_colors"),
  htmlOutput("cond_buttons", align = 'center')
)

server = function(input, output, session) {

  output$value = renderPrint({ input$num_conds })
  output$value = renderPrint({ input$num_fish })

####Condition boxes for UI text input####
  output$boxes_conds = renderUI ({
    num_conds = as.integer(input$num_conds)
    
      lapply(1:num_conds, function(i) {
        cond_names = textInput(paste0("condID", i), 
                        label = paste0("Treatment/ Conditions: ", i), 
                        placeholder = "Enter condition...")
      })
  })

####Color selection for UI input####
  output$cond_colors = renderUI ({
    num_conds = as.integer(input$num_conds)
    
      lapply(1:num_conds, function(i) {
        colourInput(paste0('colors', i), 
                  label = (paste0('Select a color for condition ', i)),
                  show = c("both"),
                  value = "black",
                  palette = c("limited"),
        )}
  )})

####Create action buttons for conditions to be selected####
  
  output$cond_buttons = renderUI ({
    num_conds = as.integer(input$num_conds)
    lapply(1:num_conds, function(i) {
    
      style = paste0(collapse = " ",
                  glue("background-color:{input$colors[[i]]};
                  color:#ffffff;
                  border-color:#000000"))
    
    
      cond_buttons = actionButton(paste0("cond_buttons", i), 
                    label = input$condID[[i]],
                   style = style
                   )
    })
  })
  
  output$cond_text <- renderText({
    num_conds = as.integer(input$num_conds)
    
    #lapply(1:num_conds, function(i) {
      start = glue('actionButton("{cond_buttons[[i]]}", "{input$condID[[i]]}",')
      style = glue('background-color:{input$colors[[i]]};"')
    
    glue('{start}\n {"             "}style = "{style})')
  })})
}

# Run the application 
shinyApp(ui = ui, server = server)

Right now, I don't get any errors. The correct number of buttons are made, but they do not adopt the colors from the color selection or the text in the buttons doesn't change with the text from the text input boxes.

Can someone help me understand what I am doing wrong here? Or if the way that I am trying to do things is necessary?


Solution

  • The issue is that the inputs containing the color codes and the labels are named colors1, colors2, ... and condID1, condID2, ... while you use e.g. input$colors[[i]] which returns NULL. Instead do input[[paste0("colors", i)]] and input[[paste0("condID", i)]]:

    library(shiny)
    library(shinythemes)
    library(sortable)
    library(colourpicker)
    library(glue)
    
    ui <- fluidPage(
      numericInput("num_conds",
        label = h3("Enter the number of treatments/ conditions"),
        min = 1,
        max = 20,
        value = 1
      ),
      uiOutput("boxes_conds"),
      uiOutput("cond_colors"),
      htmlOutput("cond_buttons", align = "center")
    )
    
    server <- function(input, output, session) {
      output$value <- renderPrint({
        input$num_conds
      })
      output$value <- renderPrint({
        input$num_fish
      })
    
      #### Condition boxes for UI text input####
      output$boxes_conds <- renderUI({
        num_conds <- as.integer(input$num_conds)
    
        lapply(1:num_conds, function(i) {
          cond_names <- textInput(paste0("condID", i),
            label = paste0("Treatment/ Conditions: ", i),
            placeholder = "Enter condition..."
          )
        })
      })
    
      #### Color selection for UI input####
      output$cond_colors <- renderUI({
        num_conds <- as.integer(input$num_conds)
    
        lapply(1:num_conds, function(i) {
          colourInput(paste0("colors", i),
            label = (paste0("Select a color for condition ", i)),
            show = c("both"),
            value = "black",
            palette = c("limited"),
          )
        })
      })
    
      #### Create action buttons for conditions to be selected####
      output$cond_buttons <- renderUI({
        num_conds <- as.integer(input$num_conds)
        lapply(1:num_conds, function(i) {
          bg <- input[[paste0("colors", i)]]
          style <- paste0(
            collapse = " ",
            glue("background-color:{bg};
                      color:#ffffff;
                      border-color:#000000")
          )
          
          label <- input[[paste0("condID", i)]]
          cond_buttons <- actionButton(paste0("cond_buttons", i),
            label = label,
            style = style
          )
        })
      })
    
      output$cond_text <- renderText({
        num_conds <- as.integer(input$num_conds)
    
        # lapply(1:num_conds, function(i) {
        start <- glue('actionButton("{cond_buttons[[i]]}", "{input$condID[[i]]}",')
        style <- glue('background-color:{input$colors[[i]]};"')
    
        glue('{start}\n {"             "}style = "{style})')
      })
    }
    
    # Run the application
    shinyApp(ui = ui, server = server)
    

    enter image description here