使用 tabsetPanel 的意外选项卡行为嵌套在闪亮的应用程序中的可反应细节函数中

Unexpected tab behavior using tabsetPanel nested within a reactable detail function in a shiny app

我闪亮的应用程序使用闪亮的 tabsetPanel 使用带有嵌套详细信息表的 Reactable。我在下面的 reprex 中重新创建了效果。我期望的是,当用户选择不同的详细信息选项卡来显示时,它会替换当前选项卡。相反,它将当前选项卡和选定选项卡堆叠在一起。我已经尝试在 tabsetPanel 的“selected =”参数中使用不同的值(请参阅边栏中的输入控件)。我达到预期行为的壁橱是使用“selected = ''”,即空字符串。但是,这会导致应用程序初始化时不显示任何详细数据。在这一点上,我试图了解这是 bug 还是 shiny tabsetPanel 的功能、可反应的详细信息功能或两者兼而有之。

感谢提前提出任何建议。

library(reactable)
library(tidyverse)
library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box

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)

ui <- dashboardPage(
  dashboardHeader(title = "Nested Reactables"),
  
  dashboardSidebar(
    radioButtons(inputId = "selected_detail",
                 label = "Select default tabPanel",
                 choices = c("detail1",
                             "detail2",
                             "detail3",
                             "detail4",
                             "empty string")
    )
  ),
  
  dashboardBody(
    reactableOutput("table")
  )
)

server <- function(input, output, session) {

  output$table <- renderReactable({

    reactable(
      data = main_table,
      details = function(index) {
        specie <- main_table$Species[[index]]
        tabsetPanel(
          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)
#> 

<sup>Created on 2021-11-15 by the [reprex package](https://reprex.tidyverse.org) (v2.0.1)</sup>

您的 radioButtons 令人困惑,因为 selection 对应于每个选项卡。因此,最好 updateRadioButtons 每次 select 不同的选项卡。如果您这样做,它将重新呈现 output$table,因为您正在使用 input$selected_detail。话虽如此,以下作品......有点。它会在您 select 一个选项卡后立即关闭选项卡,因为 Input$tabs 由于 reactable 的重新渲染而设置为 NULL。您可以第二次打开它,表格不会重叠。也许使用 javascript 有更好的方法。试试这个

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)

ui <- dashboardPage(
  dashboardHeader(title = "Nested Reactables"),

  dashboardSidebar(
    radioButtons(inputId = "selected_detail",
                 label = "Select default tabPanel",
                 choices = c("detail1",
                             "detail2",
                             "detail3",
                             "detail4",
                             "empty string")
    )
  ),

  dashboardBody(
    reactableOutput("table")
  )
)

server <- function(input, output, session) {
  
  output$table <- renderReactable({
    myselection <- input$selected_detail
    reactable(
      data = main_table,
      details = function(index) {
        specie <- main_table$Species[[index]]
        tabsetPanel(id = "tabs",
          selected = paste0(myselection,index),
          type = c("tabs"),
          
          tabPanel(
            value = paste0("detail1",index),
            title = "Sepal Length",
            reactable(
              data = dplyr::filter(nested1, Species == specie) %>% select(-Species),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value =  paste0("detail2",index),
            title = "Sepal Width",
            reactable(
              data = dplyr::filter(nested2, Species == specie),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value = paste0("detail3",index),
            title = "Petal Length",
            reactable(
              data = dplyr::filter(nested3, Species == specie),
              fullWidth = FALSE
            )
          ),
          tabPanel(
            value = paste0("detail4",index),
            title = "Petal Width",
            reactable(
              data = dplyr::filter(nested4, Species == specie),
              fullWidth = FALSE
            )
          )
        )
      })
  })
  
  observeEvent(input$tabs, {
    if (!is.null(input$tabs)) {
      value <- input$tabs
      valu  <- substr(value,1,7)
      updateRadioButtons(session, 'selected_detail', selected = valu)
    }
  })
  
  observe({
    print(input$tabs)
  })
}

shinyApp(ui = ui, server = server)