Table and Graph generation with InsertUI and removeUI buttons through shiny modules

...The problem is related to one of earlier post on insert and remove ui. I could solve the problem via shiny modules with the help of stack-overflow advice but faced problem while trying to bind a module generated table with an already existing table. The problem is that the rbinded table gets deleted as we delete the last row of the module generated table. I want to keep the preexisting table from the combined table even without the module generated table. Delete_Panels.pdf (96.3 KB)

The demo code

library(shiny)
library(dplyr)
library(ggplot2)
library(tidyverse)

Table to be combined with a user generated table derived from the panel values.

DT0 <- data.frame(event = c("Storm","Earthquake","Flood","Draught","Earthquake",
                            "Earthquake","Storm","Draught","Flood","Earthquake","Flood"),                                   
                  state = c("Telangana","Arunachal Pradesh","Assam","Jharkhand","Delhi & NCR", "Himachal Pradesh","Jammu & Kashmir","Karnataka","Kerala","Mizoram","Nagaland"),
                  year  = c(1980,1985,1985,1990,1990,1995,2000,2005,2010,2015,2020),
                  area = c(100, 200, 400, 500, 450,300,500,600,700,1700,2000),
                  money  = c(1000,2000,3000,4000,5000,6000,10000,16000,20000,26000,32000))

Table used to build a querry table which will be joined later with the DT0 table from above.

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

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"))
     )
   }
  • we have multiple input reactive (events) which comes from the main app and

  • holds the value of the event and state 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,state){
         
         killMe <- reactiveVal(FALSE)
    
    observe({
      req(input$year)
      req(event())
    
    updateNumericInput(session, 
                    "area",
                    min = 0, 
                    max = 50000,
                    value = DT1$Area_Loss[DT1$Year == input$year & 
                                            DT1$Events == event()] ,
                    step = 0.1)
    updateNumericInput(session, 
                    "money",
                    min = 0, 
                    max = 50000,
                    value = DT1$Money[DT1$Year == input$year & 
                                        DT1$Events == event()] ,
                    step = 0.1)
         })
    
    get_data <- reactive({
     
    req(!is.null(input$year), !is.null(input$area), !is.null(input$money), event(),state())
    data.frame(event = event(),
               state = unique(state()$state),
               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))
        }
         #Main App
     
    ui <- fluidPage(
         titlePanel("Modules"),
              sidebarLayout(
              sidebarPanel(
     h4("Updating Inserted UIs"),
       selectInput("events", 
               "Events",  
               unique(DT$Events)),
      actionButton("add",
                "Add"),
      selectInput("state", "State", unique(DT0$state)),
      tableOutput("table")
       ),
         mainPanel(
         tags$div(id = "Panels"),
         plotOutput("plot")  
        )
      )
    )
    

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

  get_state <- reactive({
        DF <- DT0
           if(!is.null(input$state)){
       DF1 <- DF[DF$state== input$state,]
             }
       DF1 
     })

  observeEvent(input$add, {
     id <- paste0(n)
     n <<- n + 1
     insertUI("#Panels",
              "beforeEnd",
         YAM_ui(id)
    )

    new_handler <- setNames(list(callModule(YAM_server,
                                        id,
                                        get_event,
                                        get_state)),
                        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)
          })


     Table <- reactive({

     hds <- req(handlers())
     req(length(hds) > 0)
     tbl_list <- lapply(hds, function(h) {
     h$get_data()
    }) 

   do.call(rbind, tbl_list)   
    })

PROBLEM

  • A reactive datafrme (Table) have been created from the values of get_data reactive
  • and was attemted to rbind with an alraedy avialable dataframe (DT0) with a similar schema
  • When we remove the last handler list and eventually the html via removeUI
  • then the new combined table also disappears.

EXPECTED OUTPUT

  • The DT0 table should remain intact even if we delete its rbind component i.e Table in my code

Tried to employ condition as follows which didin't work as expected

 Condn_Tried <- reactive({
        Table <- Table()
 
 if(exists("Table")){
   Combined_Table <<- rbind(DT0,Table)
 }
 else{
  Combined_Table <<- DT0
      }
 })

Don't understand that if a table cease to exists due to the associated html removal then why the above condition is not working

Is there another way to achieve what I want to do in the above Condition

 output$table <- renderTable({
      Table <- Table()
      Combined_Table <- rbind(DT0,Table)

        # Condn_Tried()
  })

Same Problem with the graph as the table and same is expected with the graph as well

     output$plot <- renderPlot({    
                 DF0 <- rbind(DT0,Table())
       
                 DF1 <- reshape2::melt(DF0,id.vars = c("event","state","year"),
                           measure.vars = c("area","money"))

     p <- ggplot(DF1,aes(x= as.factor(DF1$year), y = DF1$value, fill = DF1$variable))+
            geom_bar(stat = "identity", position = position_stack(), color = "black",width=0.7)+
            scale_x_discrete(" ", limits = c(as.character(seq("1960", "2020"))), breaks =c(as.character(seq("1980", "2020", by = 5))))+
            scale_y_continuous("Loss(In Rs)", expand = c(0,0), limits = c(0,NA))+
            scale_fill_manual(values = c("blue","green"), labels = c("area","money"))+
            scale_alpha_manual(values=c(1, .3))+
            labs(fill = "")+
            theme(aspect.ratio = 4/7)+
            theme(axis.text.x = element_text(angle = 0, vjust = -0.5,  size = 10, hjust = 0.5, color = "black",family = "Arial"),
            axis.text.y = element_text(angle = 0, vjust = 0.4,  size = 10, hjust = 1, color = "black",family = "Arial"),text = element_text(size=15,family = "Arial"),
            axis.title.y = element_text(margin = margin(t=0, r= 20, b=0, l= 0),family = "Arial"))+
            theme(legend.position= "right",legend.text=element_text(size=12,family = "Arial"),legend.key = element_rect(size = 0.01, color = NA, fill = NA),legend.key.size = unit(1, 'cm'))+
            theme(panel.grid.major = element_line(size = 0.5, linetype = "dotted", color = "black"),
            panel.border = element_blank(),panel.grid.minor = element_blank(),
            axis.line = element_line(size = 0.5, linetype = "solid",colour = "black"), panel.spacing.y = unit(100, "inch"))

        p 

     })
       # In both the graph and table I would like to keep the DT0 even when Table() is not 
          present or is deleted
 }

 shinyApp(ui, server)

Hi @Jitu,

Thanks for posting! Can you explain a little more about what you're trying to allow users to do? I got a little lost in the details of the module.

It sounds like maybe you want users to be able to allow users to add natural disasters a preexisting list and then plot the results? Is that right?

A few specific questions:

  • Why are there separate inputs for event, state, year, area, and money? It looks like you're filling all these based on the event -- do you want users to be able to edit them independently? To make different assumptions or something?
  • Why do you need a delete button? Could the previous selection just persist until they make a new selection?

Thanks for clarifying!

Thanks for asking.

Here are the table explanations

DT0 :- A preexisting table containing info about state, event, area, money and year. I have provided only one preexisting table as input source for simplicity, but in actual application there will be three separate input sources a) preexisting table related completely to states b) preexisting table related to attributes such as year, money and area c) a textInput i.e the events, but here I have combined all the inputs into one preexisting table. In actuality the two separate preexisting tables will be joined in the server side into one table based on some primary key but here I have tried to make the case as simple as possible by creating only one preexisting table.

DT1 :- A table which doesn't exist at the very beginning but is created by the user by getting information from the two input sources i.e state and event, then providing new assumptions and is saved as a table (DT1 as the case in my demo app). This table is an example to show that what is the schema of user generated table. In actuality there will be save button to store the user information in the table called DT1.

Note1 : The event column is not supposed to be in the preexisting table but I have provided it any way so as to match the schema of both the tables particularly for this demo App. The event info will only be there in the DT1 table and so don't concentrate on that column too much. The graph takes arguments only from area,money and year column.

Note 2: The event column was provided because the values of area and money are to be updated based on events and year from the DT1 table.

Save and Load:- The DT1 will be saved with new or edited assumptions from the users and subsequently loaded. I didn't provide this button for save and load in this demo App to make the code as short as possible.

Answer for the general question is partially Yes. The preexisting values are historic values may be upto 2020(The DT0 table). Values after 2020 will be entered by the user and saved in the table called DT1. In this case I have included the years from 1980-1995 in DT1 but in real case the values are only for year after 2020. The tables are there to demonstrate that the joining of tables DT0 and DT1 disappears once I delete all the entries for DT1(so, didn't give much thought of creating DT1 table with values of event for years only after 2020).

The events can only be selected from the DT1 table and not from the preexisting table.

For the first specific question the answer is absolutely Yes.

Answer for the second specific question is that we want the delete button because if suppose the user is adding three assumptions and these three assumptions are plotted alongside the preexisting historic values. But the user after a while thinks that may be I want to see two assumptions at a time and not three and that's where he/she should have the ability to delete any assumptions from the graph as they deemed fit to visualize the assumptions. Deleting all the assumptions will help the user to add panels to visualize fresh new assumptions . We shouldn't keep the last delete button as it is highly desirable that when we are visualizing only the preexisting table values (DT0) then the panels for assumptions shouldn't be present on the screen.

Suppose I am starting the app and when I open my event tab then the first thing I should see bar graphs for only the preexisting table where the assumptions panels are yet to be added which is not the case with my current App.

This is how the demo App works

  • The event is selected from the DT1 table

  • The state is selected from the preexisting table (DT0).

  • Then we select year for any event where we can also use a single column Year vector file or in this case the Year selection is from the preexisting table i.e DT0.

Please change the selection argument for the year in YAM_ui module as

                       selectInput(ns("year"), 
                                       "Year", 
                                  DT0$Year, 
                                "")

Mistakenly I have put DT in place of DT0 (Sorry for the mistake, I spotted it now only).

  • The values of area and money gets updated pertaining to that particular event and year from the user generated saved table i.e DT1. UpdateNumericInput uses the table values from DT1 in the server module.

  • In the very first instance all the values for any event will be a new entry as DT1 will be created for the first time and so no updation takes place. As we gradually grow DT1 table then we have many values pertaining to a particular event and year which then gets updated (don't have the save button and therfore cannot grow table in this demo App). Just treat DT1 as the user generated save table.

  • Once we have the values on the panel we can change the existing values or else enter new values for year, area and money for a particular event.

  • We now save the data in the DT1 table with the help of a save button.

  • DT1 table is stored internally in R but in future I may have to save the table in a SQL server, call the table and then make changes and save it again in the SQL server.

  • When we join both tables (DT0 & DT1) we can now see both the preexisting values and the user generated values in the same bar graph side by side but with the ability to delete any user generated assumption values from the graph as and when required.

Hope I have answered your questions and explain the App functionality.
Please free to ask me any number of times if I am still not able to clear your doubts.

Thanks and Regards

Jitu

Hi Alex, Sorry to disturb you

Did you get anything on my demo code?

Thanks

Jitu

Hi @Jitu,

Sorry for slow response. I'm afraid I'm having trouble following what you're trying to do here. Here's a little app that I think does a simplified version of what you're trying to do. Can you explain where this might fall short?

library(shiny)
library(ggplot2)
library(dplyr)

# base dataset
df <- tibble::tibble(
    year = seq(1960, 2000, 10),
    value = 1:5
)

# Define UI 
ui <- fluidPage(
    
    # Application title
    titlePanel("User Assumptions"),
    
    # Sidebar with a slider input for assumptions
    sidebarLayout(
        sidebarPanel(
            sliderInput("assume",
                        "Amount to Add",
                        min = 1,
                        max = 5,
                        value = 3)
        ),
        
        # Show a plot of the generated distribution
        mainPanel(
            plotOutput("plot")
        )
    )
)

# Create plot and render
server <- function(input, output) {
    
    plot_df <- reactive(df %>% 
                            mutate(assume_value = value + input$assume) %>%
                            tidyr::pivot_longer(ends_with("value")))
    
    output$plot <- renderPlot({
        plot_df() %>%
            ggplot(aes(x = year, y = value, fill = name)) +
            geom_col(position = "dodge")
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Ok, There are several things missing here

  1. The panels/widgets for assumptions are missing

  2. An add button should add these assumption panels

  3. A delete button should delete these assumption panels

  4. Don't make assume_value column later in the server side. assume_value should be independent of value column.

And

construct df table with three columns i.e Year, value and assume_value.

The assumption panels/widgets should be as follows

  1. Year
  2. value (NumericInput)
  3. assume_value (NumericInput) (basically representing the colnames of your df table)

A lit bit about the assumption panels

  • Year
  • value
  • assume_value

0 voters

Just imagine this three panels as one set of assumption panel

  1. Click Add and the the first set appears
  2. Again click add and second set appears and so on
  3. There should be a delete button for each of the set and clicking the delete button should remove that particular set.

This is supposed to happen

  • Right at the start of the App, your preexisting df table will make a bar graph

  • Now we can see the graph infront of us with x-axis as year

  • You select year and also enter something in the value and assume_value panels/widgets

For year selection you could create a year vector file such as

      Year <- data.frame(Year = 1960:2050)

and use it for Year selection and also extend the x-axis upto 2050

  • As soon as you make the new entries in the assumption panels/widgets, the entries should get reflected in the bar graph which was already rendered at the start of our App.

  • Deleting any assumption panels/widget set also removes their respective bars.

How new entries getting represented in the existing graph?

  • The new entries are used to make a reactive table

  • This reactive table joins with your preexisting table

  • Deleting any assumption panels/widget set also deletes the entries from the reactive table

Example

At present you are plotting value and assume_value upto 2020

Suppose we select a year as 2040 and for that year I make some entries in the value and assume_value panels/widgets.

Now the graph should add bars for 2040

We also should have the ability to remove the new entries and thereby removing the bar for 2040 (Clicking Delete button should do this) in which case we are again back to the original graph i.e upto 2020.

I would also like to know that, is there any possibility to talk over phone in case you are finding it very difficult to grasp what I am saying so that I could walk you through my problem

Otherwise we can always continue over R studio community

Thanks and Have a great day :beach_umbrella:

Jitu

Hi @Jitu,

Thanks for posting here on RStudio Community -- I don't believe I have a quick fix for the issue you've described. I hope I've been a helpful, but I am not able to help rewrite the application.

A few things I would consider as you're working on the app:

  • Are there ways to simplify? It sounds like you're trying to create a base plot and provide for comparisons. It would be a lot easier to just have 2 plots -- the base and a comparison. If it doesn't substantially diminish the usefulness of the app, I'd consider just having the two.
  • If you want to keep the multiple panels, I'd probably advise creating a copy of the dataframe for each instance of the panel, instead of trying to just add or remove rows. In that case, I'd create the base plot in the app.R and then write a module that takes a dataframe and creates a plot. Then you'd create a new dataframe for each panel. It's much easier to manage creating or deleting entire data frames compared to a few rows.

If you do want more help with the app, there are awesome R consultants in the community that you may want to consider working with as well: https://community.rstudio.com/groups/consultants/ I know some of these individuals focus specifically on Shiny, and would be happy to help.

Thanks for the reply

Yes I am trying to compare my assumption with the base plot. I cannot have two plots for comparisons as it is a project requirement. And you are right that having two graphs would make my case quite simple but unfortunately I am not supposed to do that.

Actually the add and delete panels in my demo App works in the same way that you are suggesting. Each set of panels create an one row data frame. Add one more set of panels and another one row data frame is created which are then joined in the App server to form a multiple row data frame. This is now joined with the preexisting table to add the new bars in the base graph. My problem is when I delete all the panels. As you are suggesting to delete the whole data frame, I couldn't do so because deleting my assumptions needs flexibility i.e user should have the option that which of the added assumptions he wants to remove or keep. He/she adds a number of assumptions and after careful analysis decides that which ones to keep and which ones to remove.

Thanks for giving your valuable and precious time on my code.
If you understood me this time than have a look at my initial post or view the PDF file for one last time.

I will also try to consider the consultants that you have suggested me

One more thing to clear that, do I need to hire them or can they solve my little problem without any fee?

Thanks and Regards

Jitu