Removing Table entries using remove UI in Shiny

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)