Search code examples
javascriptrshiny-reactivityobserversrhandsontable

How to consolidate action buttons for individual objects into a single selectInput() in R shiny?


The code posted below allows the user via clicks of action buttons to add/delete individual rhandsontable tables for data input. For deletion each table has its own action button underneath. Any ideas how to consolidate those delete action buttons into a single selectInput() where all tables are listed for deletion? I've tried un-nesting the deletion function observeEvent(input[[btnID]]...) which triggers a removeUI(), for quite a while now, but I have completely hit a brick wall.

Code:

library(shiny)
library(rhandsontable)

data1 <- data.frame(row.names = c("A","B","C","Sum"),"Tbl 1"=c(1,1,0,2),check.names=FALSE)

ui <- fluidPage(br(),
  actionButton("addTbl","Add table"),br(),br(),
  tags$div(id="placeholder",tags$div(rHandsontableOutput("hottable1")))
)

server <- function(input, output, session) {
  uiTbl <- reactiveValues(div_01_tbl = data1) 
  rv <- reactiveValues()                
  
  observeEvent(input$hottable1, {uiTbl$div_01_tbl <- hot_to_r(input$hottable1)})
  
  output$hottable1 <- renderRHandsontable({rhandsontable(uiTbl$div_01_tbl, useTypes = TRUE)})
  
  observeEvent(input$addTbl, {
    divID <- paste0("div_", if(input$addTbl+1 < 10){"0"},input$addTbl+1)
    dtID <- paste0(divID, "_DT")
    btnID <- paste0(divID, "_rmv")
    uiTbl[[paste0(divID,"_tbl")]] <- data1 
    
    insertUI(selector = "#placeholder",
      ui = tags$div(id = divID,
        rHandsontableOutput(dtID), 
        actionButton(btnID, "Delete", class = "pull-left btn btn-danger"),
      )
    )
    
    output[[dtID]] <- renderRHandsontable({
      req(uiTbl[[paste0(divID,"_tbl")]])
      rhandsontable(uiTbl[[paste0(divID,"_tbl")]], useTypes = TRUE)
    })
    
    observeEvent(input[[dtID]], {uiTbl[[paste0(divID,"_tbl")]] <- hot_to_r(input[[dtID]])})
    
    observeEvent(input[[btnID]],{
      removeUI(selector = paste0("#", divID))
      rv[[divID]] <- NULL
      uiTbl[[paste0(divID,"_tbl")]] <- NULL
    },
    ignoreInit = TRUE,
    once = TRUE)
  })
  
  observe({
    tables_list <- reactiveValuesToList(uiTbl)
    tables_list <- tables_list[order(names(tables_list))]
    table_lengths <- lengths(tables_list)
    cumsum_table_lengths <- cumsum(table_lengths)[table_lengths != 0L]
    for(i in seq_along(cumsum_table_lengths)){
      names(uiTbl[[names(cumsum_table_lengths[i])]]) <- paste("Col", cumsum_table_lengths[i])
    }
  })
  
}

shinyApp(ui, server)

Solution

  • You could collect the user's deletion choices as a reactive value in the server part:

        deletable_tables <- reactiveVal()
    

    ... add a select input to your UI (I chose a selectize input)

        selectizeInput('deletionSelector', 'delete tables:',
                       choices = NULL, multiple = TRUE,
                       options = list(placeholder = 'choose table(s)')
                       )
    

    and update this value in your event observer for input$addTbl:

        observeEvent(input$addTbl, {
        ## ...
            deletable_tables(c(deletable_tables(),  dtID))
    
            updateSelectizeInput(inputId = 'deletionSelector', 
                                 session = session, 
                                 choices = deletable_tables()
                                 )
        ## ...
        }
    

    (note that a reactiveVal is set with an argument rather than via assignment operator: my_reactive_val(x) instead of my_reactive_val <- x)

    edit Please see working version below. I added a "Delete" button: when triggering delete on selection change, tables would be removed until none are left.

    library(shiny)
    library(rhandsontable)
    
    data1 <- data.frame(row.names = c("A","B","C","Sum"),"Tbl 1"=c(1,1,0,2),check.names=FALSE)
    
    ui <- fluidPage(
        selectizeInput('deletionSelector', 'delete tables:',
                       choices = NULL, multiple = FALSE,
                       options = list(placeholder = 'choose table(s)')
                       ),
        p(actionButton('deleteTbl', 'delete selection')),
        p(actionButton("addTbl","Add table")),
        tags$div(id="placeholder",tags$div(rHandsontableOutput("hottable1"))),
        )
    
    
    server <- function(input, output, session) {
        ## store the tables in a list "data" within the
        ## reactive list "ui_tables":
        ui_tables <- reactiveValues(data = list()) 
        delete_ID <- reactiveVal()
        
        ## present initial table on initialisation
        observe({
            ui_tables$data$div_01_tbl <- rhandsontable(data1, useTypes = TRUE)
            output$hottable1 <- renderRHandsontable(ui_tables$data$div_01_tbl)
        }) |> bindEvent('input$addTbl')    
    
        observeEvent(input$addTbl, {
            divID <- sprintf('div_%02.f', input$addTbl + 1)
            dtID <- paste0(divID, '_tbl')
            ui_tables$data[[dtID]] <- rhandsontable(data1, useTypes = TRUE)
            
            insertUI(selector = "#placeholder",
                     ui = tags$div(id = divID,
                                   h4(dtID),
                                   rHandsontableOutput(outputId = dtID))
                     )
    
            output[[dtID]] <- renderRHandsontable({ui_tables$data[[dtID]]})
            
            updateSelectizeInput(
                inputId = 'deletionSelector', 
                session = session, 
                choices = c(dtID, names(ui_tables$data))
            )
        }, ignoreInit = TRUE, ignoreNULL = TRUE)
    
    
        observe({        
            delete_ID(input$deletionSelector)
            div_id  = gsub('(div_.*?)_.*$', '\\1', delete_ID())
            removeUI(selector = paste0('#', div_id))
            ui_tables$data[[delete_ID()]] <- NULL
            updateSelectizeInput(inputId = 'deletionSelector', session = session, 
                                 choices = names(ui_tables$data)
                                 )
    
        }) |>  bindEvent(input$deleteTbl)
    
    }
    
    
    shinyApp(ui, server)