R 中 Shiny 中的 renderUI 问题

Question

我正在尝试创建一个闪亮的应用程序，但我遇到了有关渲染器使用的问题UI。请找到我用来创建闪亮应用程序的以下代码。这是 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)

此处变量键将采用滑块输入的形式，并根据所选 Key/Keys，我在下拉列表中显示产品名称。现在使用 render UI 我想做的是根据 selected 产品名称，我希望产品描述以复选框的形式显示。这样我就可以 select single/Multiple 复选框并更改 table 并动态显示绘图。

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

但是当我尝试这样做时，我失败得很严重，而且我收到错误 "Error in : Result must have length 9, not 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"))
    })
}

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

R 中 Shiny 中的 renderUI 问题

Facing issues with renderUI in Shiny in R

r

shiny

shinydashboard

shiny-reactivity