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)
Advertisement
Answer
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)