How to have the label and background color of a button sent to a data.frame upon being clicked?

[cjy8s]

I have a series of action buttons, the number of which is determined by a numInput. I have a data.frame that I want to contain the label information and hexcode for the background color of the last button that I pushed. If I push a new button, the information in the data.frame should change to reflect the information of the new button. I'm just having trouble trying to figure out how to get the information from the actionButton function to the become data in the data.frame. I have tried messing with creating a eventReactive that watches for the button clicks. I've also tried messing around with the onclick part of the actionButton function. I'll keep looking, but I just don't know how to get the two to connect. Here is the minimal reproducible example, including the parts where in comments where I was stumbling around like a headless chicken. Any ideas, please?

Something similar to the verbatimTextOutput in the answer to this stack overflow question here, but in my data.frame instead of a textbox.

library(shiny)
library(sortable)
library(colourpicker)
library(glue)
library(png)
library(dplyr)
library(DT)
library(rclipboard)
library(shinyWidgets)

####Storage df####
storage_df <- (data.frame(
  matrix(ncol = 2, nrow = 1)
))

colnames (storage_df)[1] <- 'color'
colnames (storage_df)[2] <- 'condition'

# app code
ui <- fluidPage(
  
  DT::dataTableOutput("storage_table"),
  
  
  numericInput("num_conds", 
               label = h3("Enter the number of treatments/ conditions"),
               min = 1,
               max = 20,
               value = 1),
  
  htmlOutput("cond_buttons", align = 'center'),
  
  
  uiOutput("boxes_conds"),
  
  uiOutput("cond_colors"),
  
)



server <- function(input, output, session){
  
  ####Input for user browse and data upload####
  output$contents <- renderTable({ req(input$data)  })
  
  #####Slider for frames per second####
  output$value <- renderPrint({ input$Frames })
  
  #####Number output for number of conditions#####
  output$value <- renderPrint({ input$num_conds })
  
  #### 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)]]
      
      actionButton(paste0("cond_buttons", i),
                   label = label,
                   style = style, 
                   #onclick = "Shiny.setInputValue('btnLabel', this.innerText);"
      )
    })
  })
  
  output$storage_table = renderDataTable(
    storage_df, 
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE
    )
  )
  
  #  eventReactive(input[[paste0("condID", i)]]) {
  #    cond_data <- input[[paste0("condID", i)]]
  #    
  #    
  #  }
  
}
shinyApp(ui = ui, server = server)

[nirgrahamuk]

Here is one option

library(shiny)
library(sortable)
library(colourpicker)
library(glue)
library(png)
library(dplyr)
library(DT)
library(rclipboard)
library(shinyWidgets)


# app code
ui <- fluidPage(
  
  DT::dataTableOutput("storage_table"),
  
  
  numericInput("num_conds", 
               label = h3("Enter the number of treatments/ conditions"),
               min = 1,
               max = 20,
               value = 1),
  
  htmlOutput("cond_buttons", align = 'center'),
  
  
  uiOutput("boxes_conds"),
  
  uiOutput("cond_colors"),
  
)



server <- function(input, output, session){
  
  storage_df <- reactiveVal(tibble::tribble(
    ~color, ~condition
  ))
  
  #####Number output for number of conditions#####
  output$value <- renderPrint({ input$num_conds })
  
  #### 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)]]
      
      actionButton(paste0("cond_buttons", i),
                   label = label,
                   style = style, 
                   #onclick = "Shiny.setInputValue('btnLabel', this.innerText);"
      )
    })
  })
  

  
  observeEvent(input$num_conds,
               {
    lapply(1:input$num_conds, function(x){
      
      observeEvent(input[[paste0("cond_buttons",x)]],
                   {

                  newdf <- tibble(
                    color =  input[[paste0("colors",x)]],
                    condition = input[[paste0("condID",x)]]
                  )

                     storage_df(newdf)
                   })
    })
  })
  
  output$storage_table = renderDataTable(
    req(storage_df()), 
    options = list(paging = FALSE, 
                   ordering = FALSE, 
                   scrollx = FALSE,
                   searching = FALSE
    )
  )
  

}
shinyApp(ui = ui, server = server)

[cjy8s]

Thank you! I'm going to do some reading to figure out how this works. If I get stuck, is it OK if I reply to this again and ask you some questions about this?