时间戳

首页 > 解决方案 > 在 R 中的 Shiny 中面临 renderUI 的问题

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

问题描述

我正在尝试创建一个闪亮的应用程序，但我遇到了关于 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”

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

标签： rshinyshinydashboardshiny-reactivity

解决方案

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

发现了几个问题：

  • 变量有很多错别字。例如，您想要input$keynot input$keys,input$sublist_1而不是input$sublist,output$table而不是output$table1, Cost(capital 'C') 而不是cost, 等等。
  • 当您Source_Data使用子集pull而不是select提供复选框选项向量时checkboxGroupInput
  • output_func用于req建议的输入 require key, Product, 和在sublist_1尝试子集化之前Source_Data
  • 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"))
    })
}

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

推荐阅读