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"))
              ))

            ))

这是Server 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进行子集sublist_1之前要求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"))
    })
}

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