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