r - 如何在 Shiny 的仪表板中动态填充下拉框选项

Question

我正在 Shiny 的仪表板中开发一个应用程序，因为我想在上传 csv 后动态填充下拉框。下拉列表将包含我从以下代码获得的用户注册的前 10 个城市。

final_data %>%
  group_by(registrant_city) %>%
  summarise(Total = n())    %>%
  arrange(desc(Total))      %>%
  top_n(n = 10)  

这些城市应该进入下拉框。

tabItem("email",
          fluidRow(
            box(
              width = 4, status = "info",solidHeader = TRUE,
              title = "Send Emails",
              selectInput("email_select", 
                          "Select Email Content",
                          choices = c("Price" = "price",
                                      "Services" = "service"
                                      )),
              selectInput("cities", 
                          "Select City",
                           choices = ??
                          ))
                         ))

请帮忙..

Answer 1

使用 updateSelectInput在您的服务器中，如下所示，并在您的 ui 中设置 options = NULL :

function(input, output, session) {

  # If this isn't reactive you can put it in your global
  choices_cities <- final_data %>%
    group_by(registrant_city) %>%
    summarise(Total = n())    %>%
    arrange(desc(Total))      %>%
    top_n(n = 10)  

  updateSelectInput(session = session, inputId = "cities", choices = choices_cities$registrant_city)

}

或者如果 final_data是这样的 react :

function(input, output, session) {

  choices_cities <- reactive({
    final_data %>%
      group_by(registrant_city) %>%
      summarise(Total = n())    %>%
      arrange(desc(Total))      %>%
      top_n(n = 10)  
  })

  observeEvent(choices_cities(), {
    updateSelectInput(session = session, inputId = "cities", choices = choices_cities()$registrant_city)
  })

}

一个工作示例:

library("dplyr")
library("shiny")

data("world.cities", package = "maps")

ui <- fluidPage(
  sliderInput(inputId = "n", label = "n", min = 10, max = 30, value = 10),
  selectInput(inputId = "cities", label = "Select City", choices = NULL)
)

server <- function(input, output, session) {

  choices_cities <- reactive({
    choices_cities <- world.cities %>%
      arrange(desc(pop)) %>%
      top_n(n = input$n, wt = pop) 
  })

  observe({
    updateSelectInput(session = session, inputId = "cities", choices = choices_cities()$name)
  })
}

shinyApp(ui = ui, server = server)