Toggle actionButton color (between Orange & Green) on click within Shiny DT and create new data frame from selected rows

Question

I am developing a Shiny App, where the user can upload data, do some manipulations & create new df from selected rows. I have got till where I can add actionButtons per row in DT but cant make selections work. Selections work as expected if actionButtons are not included in the DT rows. What am I looking for?

1. To be able to toggle between two colors on click within each of the DT row (Orange = not selected; Green = selected, when clicked)

2. Create new data frame from selected rows of the datatable on another actionButton click (Ex: Category 01 or Category 02).

Once any of the Category 01 or Category 02 actionButton is clicked. I get this error Error: incorrect number of dimensions. As shown at the bottom of Image 2.

I have added reproducible code below.

Any help is much appreciated

As in screenshot1, actionbuttons are Orange And in screenshot2 they are Green ,

Data

data <- data.frame(Name = rep(paste("RIS", 1:20, sep = "_")),
                   Gender = rep(c("Male", "Female"), each = 10),
                   CDC = rnorm(20),
                   FDC = rnorm(20),
                   RDC = rnorm(20), 
                   LDC = rnorm(20)
                   )

Example Code

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("simpleApp"),
  sidebarLayout(
    sidebarPanel(fileInput("file1", "Upload Input file", accept = ".csv"), width = 2,
                 actionButton("calc", "Calculate"),
                 hr(style = "border-color: red; height: 5px"),
                 actionButton("gen1", "Category 01"),
                 actionButton("gen2", "Category 02")),
    mainPanel (
      dataTableOutput("table"),
      dataTableOutput("table2"),
      dataTableOutput("select_table1"),
      dataTableOutput("select_table2"))))

server <- function(input, output, session) {
  
  addButtonColumn <- function(df, id, ...) {
    f <- function(i) {
      as.character(
        actionButton(paste(id, i, sep = "_"), class = "btn-warning btn-sm", label = tags$strong("Select"),
          onclick = 'Shiny.setInputValue(\"addPressed\", this.id, {priority: "event"})'))
    }
    
    addCol <- unlist(lapply(seq_len(nrow(df)), f))
    
    DT::datatable(cbind(Decision = addCol, df), 
                  escape = FALSE, filter = "top", options = list(columnDefs = list(list(targets = 1, sortable = FALSE))))
  }
  
data <- reactive({
    df <- input$file1
    if(is.null(df))
      return(NULL)
   df <- read.csv(df$datapath, header = TRUE, sep = ",", row.names = NULL)
    return(df)
   })
  
  output$table <- DT::renderDataTable(data(), options = list(paging = t, pageLength = 6))
  
  table2 <- eventReactive(input$calc, {
    df2 <- input$file1
    if(is.null(df2))
      return(NULL)
    table2 <- data() %>%
      mutate("Selection" = CDC * RDC + FDC * LDC) %>%
      mutate(across(where(is.numeric), round, 3)) %>%
      addButtonColumn("Button")
    })
 
  output$table2 <- DT::renderDataTable(table2(), options = list(paging = t, pageLength = 6))
  
  select_table1 <- eventReactive(input$gen1, {
    if(is.null(table2)){
       return(NULL)
    } else {
      select_table1 <- table2()[input$table2_rows_selected,]
    } 
  })
  
  select_table2 <- eventReactive(input$gen2, {
    if(is.null(table2)){
      return(NULL)
    } else {
      select_table2 <- table2()[input$table2_rows_selected,]
    } 
  })
  
  output$select_table1 <- DT::renderDataTable(select_table1(), options = list(paging = t, pageLength = 6))
  output$select_table2 <- DT::renderDataTable(select_table2(), options = list(paging = t, pageLength = 6))
}

shinyApp(ui = ui, server = server)

score 1 · Accepted Answer · answered Oct 25 '22 at 22:53

Some simple CSS can do it.
You called DT::datatable too early in the eventReactive. You need to call it within renderDataTable, otherwise, the render function can't recognize it properly (it can, but table2_rows_selected will not work).

df <- data.frame(Name = rep(paste("RIS", 1:20, sep = "_")),
                   Gender = rep(c("Male", "Female"), each = 10),
                   CDC = rnorm(20),
                   FDC = rnorm(20),
                   RDC = rnorm(20), 
                   LDC = rnorm(20)
)

library(shiny)
library(DT)

ui <- fluidPage(
    titlePanel("simpleApp"),
    sidebarLayout(
        sidebarPanel(fileInput("file1", "Upload Input file", accept = ".csv"), width = 2,
                     actionButton("calc", "Calculate"),
                     hr(style = "border-color: red; height: 5px"),
                     actionButton("gen1", "Category 01"),
                     actionButton("gen2", "Category 02")),
        mainPanel (
            dataTableOutput("table"),
            dataTableOutput("table2"),
            dataTableOutput("select_table1"),
            dataTableOutput("select_table2"))),
    tags$style(
        '
        table.dataTable tr.selected button {
            background-color: green;
            border-color: green;
        }
        '
    )
)

server <- function(input, output, session) {
    
    addButtonColumn <- function(df, id, ...) {
        f <- function(i) {
            as.character(
                actionButton(paste(id, i, sep = "_"), class = "btn-warning btn-sm", label = tags$strong("Select"),
                             onclick = 'Shiny.setInputValue(\"addPressed\", this.id, {priority: "event"})'))
        }
        
        addCol <- unlist(lapply(seq_len(nrow(df)), f))
        
        cbind(Decision = addCol, df)
    }
    
    data <- reactive({
        df
    })
    
    output$table <- DT::renderDataTable(data(), options = list(paging = t, pageLength = 6))
    
    table2 <- eventReactive(input$calc, {
        df2 <- df
        if(is.null(df2))
            return(NULL)
        data() %>%
            mutate("Selection" = CDC * RDC + FDC * LDC) %>%
            mutate(across(where(is.numeric), round, 3)) %>%
            addButtonColumn("Button")
    })
    
    output$table2 <- DT::renderDataTable(DT::datatable(
        table2(), escape = FALSE, filter = "top", 
        options = list(columnDefs = list(list(targets = 1, sortable = FALSE, paging = t, pageLength = 6)))
    ))
    
    select_table1 <- eventReactive(input$gen1, {
        if(is.null(table2)){
            return(NULL)
        } else {
            print(input$table2_rows_selected)
            select_table1 <- table2()[input$table2_rows_selected,]
        } 
    })
    
    select_table2 <- eventReactive(input$gen2, {
        if(is.null(table2)){
            return(NULL)
        } else {
            select_table2 <- table2()[input$table2_rows_selected,]
        } 
    })
    
    output$select_table1 <- DT::renderDataTable(DT::datatable(select_table1(),  escape = FALSE, options = list(paging = t, pageLength = 6)))
    output$select_table2 <- DT::renderDataTable(select_table2(), escape = FALSE, options = list(paging = t, pageLength = 6))
}

shinyApp(ui = ui, server = server)

Disabled your uploading part. You need to change it back.

Thank you Iz100. It worked perfectly as expected. Appreciate it. — Sandeep Patil, Oct 27 '22 at 08:40
In addition, can we add Select All, Deselect All buttons at the top for this DT? — Sandeep Patil, Oct 28 '22 at 12:49
Check posts like this https://stackoverflow.com/questions/49021551/select-all-checkbox-for-shiny-dtrenderdatatable and this https://stackoverflow.com/questions/62838573/use-shiny-actionbutton-to-select-all-rows-or-add-all-rows-to-selection-in-curren — lz100, Oct 28 '22 at 23:15

Toggle actionButton color (between Orange & Green) on click within Shiny DT and create new data frame from selected rows

1 Answers1