Removing Table entries using remove UI in Shiny - r

Question

I am populating a table by using Insert UI elements. I also want to delete both table entries and the inserted panels by using the remove UI elements.
I could delete the panels but as you can see in my demo App the corresponding table values are not deleted and the length of the table remains the same even after clicking the delete button.
How can I delete both the panels and their corresponding table values at the same time?
Why table values are not getting deleted?
library(shiny)
library(tidyverse)
DT <- data.frame(Year = c(1980,1985,1985,1990,1990,1995),
Events = c("Storm", "Earthquake", "Flood", "Draught",
"Earthquake", "Earthquake"),
Area_Loss = c(100, 200, 400, 500, 450,300),
Money = c(1000,2000,3000,4000,5000,6000))
ui <- fluidPage( h4("Updating InserUIs",
selectInput("events","Events",choices=as.character(DT$Events)),
tags$div(id = "Panels"),
actionButton("add","Add"),
tableOutput("table"),
verbatimTextOutput("text")
))
server <- function(session, input, output){
# Reactive values for the number of input panels
vals <- reactiveValues(btn = list(), observers = list())
observeEvent(input$add,ignoreNULL = FALSE,{
l <- length(vals$btn) +1
# Add Panels
for(i in l){
vals$btn[[i]]= insertUI(selector = "#Panels",
ui = splitLayout(id = paste0("Selection",i), where ="afterEnd",
cellWidths = rep("33.33%",3),
selectInput(paste0("year",i), "Year", choices = DT$Year,
selected = ""),
numericInput(paste0("area",i), "Area", min = 0, max = 10000,
value ="", step = 1),
numericInput(paste0("money",i), "Money", min = 0, max = 10000,
value = "", step =1),
div(id ="delete_div",actionButton(paste0("delete",i), "Delete"))
))}
# Update panels
for(i in l){
vals$observers = lapply(l, function(i)
observeEvent(input[[paste0("year",i)]],{
updateNumericInput(session,paste0("area",i),
"Area",min= 0, max= 50000,value = DT$Area_Loss
[DT$Year == input[[paste0("year",i)]]& DT$Events==
input$events] ,step = 0.1)
}))}
for(i in l){
vals$observers = lapply(l, function(i)
observeEvent(input[[paste0("year",i)]],{
updateNumericInput(session,paste0("money",i),
"Money",min= 0, max= 50000,value = DT$Money
[DT$Year == input[[paste0("year",i)]]& DT$Events==
input$events] ,step = 0.1)
}))}
# Delete Panels
for(i in l){
observeEvent(input[[paste0("delete",i)]],{
shiny::removeUI(selector = paste0("#Selection",i))
i <- length(vals$btn) - 1
})}
})
# Reactive table generated from the user inputs
Table <- reactive({
l <- 1:length(vals$btn)
for(i in l){
Year <- unlist(lapply(l, function(i)input[[paste0("year",i)]]))
Area <- unlist(lapply(l, function(i)input[[paste0("area",i)]]))
Money <- unlist(lapply(l, function(i)input[[paste0("money",i)]]))
}
DF0 <- data.frame(Event = input$events,
Year = Year,
Area_loss = Area,
Money = Money
)
DF0
})
# Visualizing the raective table
output$table <- renderTable({
Table()
})
}
shinyApp(ui,server)
Thanks all of you in advance, any suggestion will help me to progress in my app.

Answer 1

I think your problem can be quiet elegantly solved with modules. See comments in the code for details.
library(shiny)
library(dplyr)
DT <- data.frame(Year = c(1980,1985,1985,1990,1990,1995),
Events = c("Storm", "Earthquake", "Flood", "Draught",
"Earthquake", "Earthquake"),
Area_Loss = c(100, 200, 400, 500, 450,300),
Money = c(1000,2000,3000,4000,5000,6000))
##############################Module#############################
## a module consists of all elements which belong together
## i.e. year, area, money and delete button
## take note about the ns() construct which allows for
## namespacing and through this mechanism we can have several
## instances of this module
YAM_ui <- function(id) {
ns <- NS(id)
fluidRow(
id = id,
h3(id),
column(width = 3,
selectInput(ns("year"),
"Year",
DT$Year,
"")),
column(width = 4,
numericInput(ns("area"),
"Area",
0,
0,
10000,
1)),
column(width = 4,
numericInput(ns("money"),
"Money",
0,
0,
10000,
1)),
column(width = 1,
actionButton(ns("delete"), "Delete"))
)
}
## in the server you can access the elements simply by input$element_name
## we have one input reactive (event) which comes from the main app and
## holds the value of the event selectInput
## we return
## - a killSwitch to signal the main app to delete this module
## - a reactive which returns the data from all inputs organized in a data frame
YAM_server <- function(input, output, session, event) {
killMe <- reactiveVal(FALSE)
observe({
req(input$year)
req(event())
updateNumericInput(session,
"area",
min = 0,
max = 50000,
value = DT$Area_Loss[DT$Year == input$year &
DT$Events == event()] ,
step = 0.1)
updateNumericInput(session,
"money",
min = 0,
max = 50000,
value = DT$Money[DT$Year == input$year &
DT$Events == event()] ,
step = 0.1)
})
get_data <- reactive({
req(!is.null(input$year), !is.null(input$area), !is.null(input$money), event())
data.frame(event = event(),
year = input$year,
area = ifelse(input$area == "", NA, input$area),
money = ifelse(input$money == "", NA, input$money))
})
observeEvent(input$delete,
killMe(TRUE))
return(list(delete = killMe,
get_data = get_data))
}
##############################MainApp##############################
ui <- fluidPage(
titlePanel("Modules"),
sidebarLayout(
sidebarPanel(
h4("Updating Inserted UIs"),
selectInput("events",
"Events",
unique(DT$Events)),
actionButton("add",
"Add"),
tableOutput("table")
),
mainPanel(
tags$div(id = "Panels")
)
)
)
## in the main App we have
## - a reactive (handlers) which holds all reactives of all the modules
## - a list (observers) where we create (and delete) observers for the kill
## switch
## When we add a row, we use insertUI to create the html and callModule
## to switch on the modules server logic. We pass the event reactive to
## the module to make it available within the module.
## When we observe a press to the delete button, we remove the handler
## from the lists and remove the corresponding html via removeUI.
## The data table is then updated automatically, because we removed the handler
## and it is not seen in the loop
## To get the table all we have to do is to loop through all handlers and
## call the get_data reactive from the modules to get the data
server <- function(input, output, session) {
handlers <- reactiveVal(list())
observers <- list()
n <- 1
get_event <- reactive({
input$events
})
observeEvent(input$add, {
id <- paste0("row_", n)
n <<- n + 1
insertUI("#Panels",
"beforeEnd",
YAM_ui(id)
)
new_handler <- setNames(list(callModule(YAM_server,
id,
get_event)),
id)
handler_list <- c(handlers(), new_handler)
handlers(handler_list)
})
observe({
hds <- handlers()
req(length(hds) > 0)
new <- setdiff(names(hds),
names(observers))
obs <- setNames(lapply(new, function(n) {
observeEvent(hds[[n]]$delete(), {
removeUI(paste0("#", n))
hds <- handlers()
hds[n] <- NULL
handlers(hds)
observers[n] <<- NULL
}, ignoreInit = TRUE)
}), new)
observers <<- c(observers, obs)
})
output$table <- renderTable({
hds <- req(handlers())
req(length(hds) > 0)
tbl_list <- lapply(hds, function(h) {
h$get_data()
})
do.call(rbind, tbl_list)
})
}
shinyApp(ui, server)

Answer 2

I agree with #thothal that modules help when adding and removing sections of UI and the corresponding data. I've taken a lot of inspiration from their answer and come up with a slightly cleaner (IMHO) implementation.
I've only modified the final server function, where I have managed to do away with the need to keep a list of observers and have captured most of the lifecycle functionality into the add_module function
# utility to hide away the mess of updating the reactiveVal(list())
update_values <- function(values, name, value) {
vals <- values()
vals[[name]] <- value
values(vals)
}
add_module <- function(values, name, server, delete_hook = NULL, remove_selector = NULL) {
# add module server's return to values list
update_values(values, name, server)
# if module has a reactive we should monitor for deleting, do so
if (!is.null(delete_hook)) {
observeEvent(
server[[delete_hook]](), {
removeUI(selector = remove_selector) # remove the ui
update_values(values, name, NULL) # remove the server from our values list
},
ignoreInit = TRUE,
once = TRUE
)
}
}
server <- function(input, output, session) {
handlers <- reactiveVal(list())
get_event <- reactive({
input$events
})
# new
observeEvent(input$add, {
id <- paste0("row_", input$add)
insertUI("#Panels", "beforeEnd", YAM_ui(id))
add_module(
handlers,
name = id,
server = callModule(YAM_server, id, get_event),
delete_hook = "delete",
remove_selector = paste0("#", id)
)
})
# unchanged
output$table <- renderTable({
hds <- req(handlers())
req(length(hds) > 0)
tbl_list <- lapply(hds, function(h) {
h$get_data()
})
do.call(rbind, tbl_list)
})
}
shinyApp(ui, server)