Question

在我正在创建的闪亮应用程序中，我有一组下拉列表框，它们相互关联。那是一个下拉框的输入决定其他输入的集合。请在下面找到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和服务器代码

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”。这没有显示在闪亮的应用程序中。相反，我得到的输出如下图所示。

有人可以帮我解决我正在犯的错误吗？或者就如何克服此错误提供任何建议。

谢谢。

Answer 1

在观察事件中仅删除dat[.N, x:=0, by=group]函数似乎可以解决问题-现在，当在“产品列表”下选择“表”时，“产品描述”下唯一可以选择的选项是“ XX”。

unique

Answer 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]
    )
})

Shiny App中的updateSelectInput函数面临的问题

2 个答案: