在 R 中的 Shiny 中面临 renderUI 的问题

Question

我正在尝试创建一个闪亮的应用程序，但我遇到了关于 renderUI 使用的问题。请找到我用来创建闪亮应用程序的以下代码。这是 UI 脚本和示例数据框。

library(shiny)
library(tidyverse)
library(data.table)
library(ggplot2)

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", "XXXX", "YY", "X", "Z", "ZZZ", "A", "Y", "A"),
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),
                uiOutput("sublist")
              ),
              mainPanel(tabsetPanel(
                type = "tabs",
                tabPanel("table_data", DT::dataTableOutput("table")),
                tabPanel("Visualizing Data", plotOutput("plot"))
              ))

            ))

这是服务器 R 脚本

server <- function(input, output, session) {
observe({
x <-
  Source_Data %>% filter(key %in% input$key) %>% select (Product_Name)
updateSelectInput(session, "Product", "List of Products", choices =
                    unique(x))
})

#### Using render UI here #######

output$sublist <- renderUI({
tagList(
  z <- Source_Data %>% filter(key %in% input$keys & Product_Name %in%
                                input$Product) %>% select (Product_desc),
  checkboxGroupInput("sublist_1", "Descriptions", z)
)
})


output_func <- reactive({
key_input <- input$key
Product_input <- input$Product
cat_input <- input$sublist

d <- Source_Data %>% dplyr::select(key,
                                   Product_Name,
                                   Product_desc,
                                   Cost) %>% dplyr::filter (key %inrange% 
key_input,
                                                            Product_Name == 
Product_input,
                                                            Product_desc == 
cat_input)
return(d)
})

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

output$plot <-
renderPlot({
  ggplot(output_func(), aes (key, cost, fill = Product_desc))
})
}

shinyApp(ui = ui, server = server)

这里的变量键将采用滑块输入的形式，根据选定的键/键，我在下拉列表中显示产品名称。现在使用渲染 UI 我想要做的是 根据所选的产品名称，我希望产品描述以复选框的形式显示。这样我就可以选择单个/多个复选框并动态更改表格和绘图显示。

这样，在每个键值下，每个产品名称的产品描述都会发生变化。此外，如果我没有选择任何产品名称，则不应出现任何复选框。

但是当我尝试这样做时，我失败得很厉害，而且我收到错误“错误：结果必须长度为 9，而不是 0”

任何有关如何进一步进行此操作的帮助都会对我有很大帮助。 提前致谢。

Answer 1

也许这个问题现在已经解决了，但以防万一这里有一个可行的解决方案。

发现了一些问题：

• 变量有许多拼写错误。例如，您想要input$key 而不是input$keys、input$sublist_1 而不是input$sublist、output$table 而不是output$table1、Cost（大写'C'）而不是cost，等等李>
• 当对Source_Data 进行子集化时，使用pull 而不是select 为checkboxGroupInput 提供一个复选框选项向量
• 在output_func 中使用req 作为输入，建议在尝试对Source_Data 进行子集化之前需要key、Product 和sublist_1
• 在output_func 中设置数据子集，您可能希望Product_desc %in% cat_input 处理一次选中的多个复选框，因此不要将字符串与字符串向量进行比较
• 我为示例更改了您的 ggplot，但我注意到您对此有一个单独的未解决问题

这是服务器代码：

server <- function(input, output, session) {
  observe({
    x <- Source_Data %>% 
           filter(key %in% input$key) %>% 
             select (Product_Name)
    updateSelectInput(session, "Product", "List of Products", choices = unique(x))
  })

  #### Using render UI here #######

  output$sublist <- renderUI({
    z <- Source_Data %>% 
      filter(key %in% input$key & Product_Name %in% input$Product) %>% 
        pull (Product_desc)
    tagList(
      checkboxGroupInput("sublist_1", "Descriptions", z)
    )
  })


  output_func <- reactive({
    req(input$key, input$Product, input$sublist_1)

    key_input <- input$key
    Product_input <- input$Product
    cat_input <- input$sublist_1

    d <- Source_Data %>% 
      dplyr::select(key,
                     Product_Name,
                     Product_desc,
                     Cost) %>% 
      dplyr::filter (key %inrange% key_input,
                    Product_Name == Product_input,
                    Product_desc %in% cat_input)

    return(d)
  })

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

  output$plot <-
    renderPlot({
      output_func() %>%
        ggplot(aes(Product_Name, Cost)) + 
        geom_col(aes(fill = Product_desc), position = position_dodge(preserve = "single"))
    })
}

我希望这会有所帮助 - 如果这是您的想法，请告诉我。祝你好运！