使用闪亮的新信息更新下拉列表

Question

我正在 Shiny 上做一个项目，其中有几个下拉菜单。菜单中包含的选项存储在数据框中，当运行应用程序时，您可以选择向数据框中添加更多数据。我预期的行为是下拉菜单中的选项会随着数据框中的更改自动更新，但这并没有发生。

这可以在 Shiny 中完成吗？如果是，如何？

这是一个代码，其中包含我正在做的示例。

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

Answer 1

你这里有几个问题。

第二个 selectInput 取决于第一个，因此您还需要更新它以显示更新后的数据框。
最好创建一个 reactiveValues 对象作为要更新的数据框。
您需要 observeEvent 来更新第二个 selectInput，每当第一个更新时。

最后，仅当单击第二个选项卡上的 actionButton 时才会更新数据框 - 以避免在键入长文本时更新数据框。

试试这个

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)

使用闪亮的新信息更新下拉列表

Update drop-down list with new information in shiny

r

shiny

shinydashboard