面对 Shiny App 中 updateSelectInput 函数的问题答案

【问题标题】：Facing issues with updateSelectInput function in Shiny App面对 Shiny App 中 updateSelectInput 函数的问题
【发布时间】：2019-12-25 15:46:34
【问题描述】：

在我正在创建的闪亮应用程序中，我有一组相互连接的下拉列表框。即一个下拉框的输入决定了其他人的输入集。请在下面找到 UI 和服务器代码。

Source_Data <-
data.frame(
key = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
Product_Name = c(
  "Table",
  "Table",
  "Chair",
  "Table",
  "Bed",
  "Bed",
  "Sofa",
  "Chair",
  "Sofa"
),
Product_desc = c("XX", "XX", "YY", "XX", "Z", "ZZZ", "A", "Y", "AA"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)

用户界面和服务器代码

ui <- fluidPage(titlePanel("Demo"),
            sidebarLayout(
              sidebarPanel(
                sliderInput(
                  "key",
                  "keys",
                  min = 1,
                  max = 3,
                  value = c(1, 3),
                  step = 1
                ),
                selectInput("Product", "List of Products", choices = NULL),
                selectInput("Product_d", "Product Description", choices = NULL),
                actionButton("Button", "ok")
              ),
              mainPanel(tabsetPanel(
                type = "tabs",
                tabPanel("table_data", DT::dataTableOutput("table"))
              ))

            ))



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

observeEvent(input$key, {
updateSelectInput(session,
                  "Product",
                  "List of Products",
                  choices = unique(
                    Source_Data %>% filter(key %in% input$key) %>% select 
(Product_Name)
                  ))
 })

observeEvent(c(input$key, input$Product), {
updateSelectInput(
  session,
  "Product_d",
  "Product Description",
  choices = unique(
    Source_Data %>% filter(key %in% input$key,
                           Product_Name %in% input$Product) %>% select 
 (Product_desc),
    selected = TRUE
  )
 )

 })

 output_func <- eventReactive(input$Button, {
 key_input <- input$key
 Product_input <- input$Product
 Product_desc_input <- input$Product_d
 cat_input <- input$Product_desc
 div_input <- input$divisions

  z <-
  Source_Data %>% dplyr::arrange (key) %>% dplyr::select(
    key,
    Product_Name,
    Product_Desc,
    Cost
  ) %>% dplyr::filter (
    key %inrange% key_input,
    Product_Name == Product_input,
    Product_Desc == Product_desc_input
  )

   return(z)
  })

output$table_data <-
DT::renderDataTable({
  DT::datatable(output_func())
})}


 shinyApp(ui = ui, server = server)

我面临的问题是，如果特定产品只有一个唯一的产品描述，那么在产品描述框中不会显示单个唯一值。

例如在 Source_data 中，产品“表”只有一个唯一的产品描述“XX”。这不会显示在闪亮的应用程序中。相反，我得到的输出如下图所示。

有人可以帮我解决我在做什么错误，或者就如何克服这个错误提供任何建议。

提前致谢。

【问题讨论】：

标签： r shiny reactive-programming shinydashboard reactive

【解决方案1】：

在您的观察事件中简单地删除unique 函数似乎可以解决问题 - 现在在产品列表下选择表格时，产品描述下唯一可供选择的选项是“XX”。

observeEvent(c(input$key, input$Product), {
    updateSelectInput(
        session,
        "Product_d",
        "Product Description",
        choices = 
            Source_Data %>% filter(key %in% input$key,
                                   Product_Name %in% input$Product) %>% 
                select(Product_desc),
            selected = FALSE

    )

})

【讨论】：

【解决方案2】：

如果你希望第一个选项仍然默认选中，也许你可以试试这个：

observeEvent(c(input$key, input$Product), {
    updateSelectInput(
        session,
        "Product_d",
        "Product Description",
        choices = unique(
            Source_Data %>% 
                filter(key %in% input$key, Product_Name %in% input$Product) %>% 
                select(Product_desc)
        )[,1]
    )
})

【讨论】：