Блог

Я занимаюсь проектом в 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)
 

Здесь у вас есть несколько проблем.

1. Второе selectInput зависит от первого, поэтому вам также необходимо обновить его, чтобы отобразить обновленный фрейм данных.
2. Было бы лучше всего создать reactiveValues объект в качестве фрейма данных для обновления.
3. Вам нужно 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)