0

有很多与动态创建选项卡面板相关的非常有用的帖子（例如Zarzar），但我没有找到与我的用例相匹配的帖子，特别是在可反应的详细信息函数中创建自定义 tabsetPanel。我有一个大型的闪亮仪表板应用程序，它使用可反应的详细信息功能来显示嵌套数据，特别是主表每一行下的 tabsetPanel 内的一组闪亮的 tabPanels (5)。我可以手动创建效果，但是很多行没有数据，所以很多选项卡都包含空表。这个很贵而且很减缓。因此，我需要一个函数放置在可反应的详细信息函数中，该函数将生成自定义设置选项卡面板，即没有带有空表的选项卡。reprex 使用一个小型玩具数据集来显示（在右侧）我正在寻找的结果的表示，“手动”创建，以及我尝试使用 purrr::iwalk 复制效果，但在创建方面取得了成功tabsetPanel 需要的内容。请参阅左侧面板上的错误消息：*

bslib::nav()“警告：错误：导航容器需要/ shiny::tabPanel()s 和/或 bslib::nav_menu()/ s的集合 shiny::navbarMenu()。考虑使用header或者 footer如果您希望将内容放置在每个面板的内容之上（或之下）。”

这是我的代表

library(reactable)
library(tidyverse)
library(shiny)
#> 
#> Attaching package: 'shiny'
#> The following objects are masked from 'package:DT':
#> 
#>     dataTableOutput, renderDataTable
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box

# data

main_table <- iris %>% 
  select(Species) %>% 
  unique()

nested1 <- iris %>% 
  select(Species, Sepal.Length)
nested2 <- iris %>% 
  select(Species, Sepal.Width)
nested3 <- iris %>% 
  select(Species, Petal.Length)
nested4 <- iris %>% 
  select(Species, Petal.Width)

nested_tables_list <- list(
  "Sepal.Length" = nested1,
  "Sepal.Width" = nested2,
  "Petal.Length" = nested3,
  "Petal.Width" = nested4
)

# ui

ui <- dashboardPage(
  dashboardHeader(title = "Nested Reactables"),
  
  dashboardSidebar(collapsed = TRUE),
  
  dashboardBody(
    fluidRow(
      box(reactableOutput("dynamic"), title = "dynamically created tabpanels"),
      box(reactableOutput("manual"), title = "manually created tabpanels")
    )
  )
)

server <- function(input, output, session) {
  
  # This is the code that fails. The aim is to create dynamically a tabPanel collection to fill a tabsetPanel
  
  output$dynamic <- renderReactable({
    
    reactable(
      data = main_table,
      details = function(index) {
        specie <- main_table$Species[[index]]
        tabsetPanel(
          id = "nested_tables",
          selected = input$selected_detail,
          type = c("tabs"),
          {
            nested_tables_list %>% 
              iwalk(~tabPanel(.y, reactable(.x)))
          }
        )}
    )
  })
  
  # This output is included only to show the effect I am trying to create.
  
  output$manual <- renderReactable({
    
    reactable(
      data = main_table,
      details = function(index) {
        specie <- main_table$Species[[index]]
        tabsetPanel(
          id = "nested_tables",
          selected = input$selected_detail,
          type = c("tabs"),
          tabPanel(
            value = "detail1",
            title = "Sepal Length",
            reactable(
              data = filter(nested1, Species == specie) %>% select(-Species),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value = "detail2",
            title = "Sepal Width",
            reactable(
              data = filter(nested2, Species == specie),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value = "detail3",
            title = "Pedal Length",
            reactable(
              data = filter(nested3, Species == specie),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value = "detail4",
            title = "Pedal Width",
            reactable(
              data = filter(nested4, Species == specie),
              fullWidth = FALSE
            )
          )
        )
      })
  })
}

shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:4213
#> List of 4
#>  $ Sepal.Length:'data.frame':    150 obs. of  2 variables:
#>   ..$ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
#>   ..$ Sepal.Length: num [1:150] 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
#>  $ Sepal.Width :'data.frame':    150 obs. of  2 variables:
#>   ..$ Species    : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
#>   ..$ Sepal.Width: num [1:150] 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
#>  $ Petal.Length:'data.frame':    150 obs. of  2 variables:
#>   ..$ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
#>   ..$ Petal.Length: num [1:150] 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
#>  $ Petal.Width :'data.frame':    150 obs. of  2 variables:
#>   ..$ Species    : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
#>   ..$ Petal.Width: num [1:150] 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
#> Warning: Error in : Navigation containers expect a collection of `bslib::nav()`/
#> `shiny::tabPanel()`s and/or `bslib::nav_menu()`/`shiny::navbarMenu()`s. Consider
#> using `header` or `footer` if you wish to place content above (or below) every
#> panel's contents.

由reprex 包于 2021-11-30 创建(v2.0.1)

4

0 回答 0