Search code examples
rshinyshinydashboard

Update drop-down list with new information in shiny


I'm doing a project on Shiny where there are several drop-down menus. The options contained in the menus are stored in a data frame and when running the app you have the option to add more data to the data frame. The behavior I expected was that the options in the drop-down menu would automatically update with changes in the data frame, but this doesn't happen.

Is this possible to be done in Shiny? If yes, how?

Here's a code with an example of how I'm doing.

### EXEMPLO ###
## 1. Data 
carros <- data.frame(MARCA = c("CHEVROLET", "CHEVROLET", "CHEVROLET", "FIAT", "FIAT" ),
                     MODELO = c("CORSA", "CELTA", "ONIX", "MOBI", "STRADA"))
carros    

## 2. Shiny
library(shinydashboard)
library(shiny)
library(DT)
library(shinyjs)
library(dplyr)
library(digest)
library(stringr)
library(shinyalert)

ui <- dashboardPage(skin = "red",
                    dashboardHeader(title = "Marca de carros"),
                    
                    dashboardSidebar(sidebarMenu(
                      menuItem("Geral", tabName = "geral"),
                      menuItem("Adicionar", tabName = "add")
                    )),
                    
                    dashboardBody(tabItems(
                      tabItem(tabName = "geral",
                              p("Lista de marcas e modelos",style = "font-size:20px"),
                              selectInput("marca", "Marca", c("", carros$MARCA)),
                              selectInput("modelo", "Modelo", c("", carros$MODELO)),
                              actionButton("envio", "Enviar", class = 'btn-primary')),
                      tabItem(tabName = "add",
                              p("Adicionar novas marcas e modelos",style = "font-size:20px"),
                              textInput("marcanova", "Marca"),
                              textInput("modelonovo", "Modelo"),
                              actionButton("cadastro", "Enviar", class = 'btn-primary'))
                    ))
)



server <- function(input, output, session){
  #menu condicional
  var2.choice <- reactive({
    carros %>%
      filter(MARCA == input$marca) %>%
      pull(MODELO)
  })
  observe({
    updateSelectInput(session, "modelo", choices = var2.choice())
  })
  #fim do menu condicional
  
  # add notificacao de enviado
  observeEvent(input$envio, {
    showNotification("Enviado")
  })
  # fim da notificacao
  
  # add notificacao de cadastrado
  observeEvent(input$cadastro, {
    showNotification("Cadastrado")
  })
  # fim da notificacao
  
  ## juntando as informacoes
  observeEvent(input$cadastro,{
    carros <- rbind(carros, data.frame(MARCA=c(input$marcanova),
                                       MODELO = c(input$modelonovo)))
  })
  
}

shinyApp(ui, server)

Solution

  • You have several issues here.

    1. The second selectInput depends on the first one, so you need to update it also to display the updated dataframe.
    2. It would be best to create a reactiveValues object as the dataframe to be updated.
    3. You need an observeEvent to update the second selectInput, whenever the first one is updated.

    Lastly, dataframe is updated only when the actionButton on the second tab is clicked - to avoid updating dataframe while typing long text.

    Try this

    ui <- dashboardPage(skin = "red",
                        dashboardHeader(title = "Marca de carros"),
                        
                        dashboardSidebar(sidebarMenu(
                          menuItem("Geral", tabName = "geral"),
                          menuItem("Adicionar", tabName = "add")
                        )),
                        
                        dashboardBody(tabItems(
                          tabItem(tabName = "geral",
                                  p("Lista de marcas e modelos",style = "font-size:20px"),
                                  selectInput("marca", "Marca", c("", carros$MARCA)),
                                  selectInput("modelo", "Modelo", c("", carros$MODELO)),
                                  actionButton("envio", "Enviar", class = 'btn-primary')),
                          tabItem(tabName = "add",
                                  p("Adicionar novas marcas e modelos",style = "font-size:20px"),
                                  textInput("marcanova", "Marca"),
                                  textInput("modelonovo", "Modelo"),
                                  actionButton("cadastro", "Enviar", class = 'btn-primary'),
                                  DTOutput("t1")
                                  )
                        ))
    )
    
    
    
    server <- function(input, output, session){
      rv <- reactiveValues(carros=carros)
      #menu condicional
      var2.choice <- eventReactive(input$marca, {
        req(input$marca)
        rv$carros %>%
          filter(MARCA == input$marca) %>%
          pull(MODELO)
      })
      observe({
        updateSelectInput(session, "marca", choices = unique(rv$carros[,1]))
      })
      observeEvent(input$marca,{
        updateSelectInput(session, "modelo", choices = var2.choice()) # unique(rv$carros[rv$carros[,1] == input$marca,2]))
      })
      #fim do menu condicional
      
      # add notificacao de enviado
      observeEvent(input$envio, {
        showNotification("Enviado")
      })
      # fim da notificacao
      
      # add notificacao de cadastrado
      observeEvent(input$cadastro, {
        showNotification("Cadastrado")
      })
      # fim da notificacao
      
      newdf <- eventReactive(input$cadastro, {
        req(input$marcanova,input$modelonovo)
        df <- rbind(rv$carros, data.frame(MARCA=as.character(input$marcanova),
                                          MODELO = as.character(input$modelonovo)))
      })
      
      ## juntando as informacoes
      observe({
        req(input$marcanova,input$modelonovo,newdf())
        rv$carros <- newdf()
      })
      
      output$t1 <- renderDT({rv$carros})
    }
    
    shinyApp(ui, server)