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

Question

我的闪亮应用使用闪亮的 tabsetPanel 使用可反应嵌套的详细信息表。我在下面的 reprex 中重新创建了效果。我期望的是，当用户选择不同的详细信息选项卡来显示时，它会替换当前的选项卡。相反，它将当前选项卡和选定选项卡堆叠在一起。我已经尝试在 tabsetPanel 的“selected =”参数中使用不同的值（请参阅侧栏中的输入控件）。我达到预期行为的壁橱是使用“selected = ''”，即一个空字符串。但是，这会导致应用程序在不显示详细数据的情况下进行初始化。在这一点上，我试图了解这是一个错误还是闪亮的 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>

Answer 1

您的radioButtons 令人困惑，因为选择对应于每个选项卡。因此，每次选择不同的选项卡时最好updateRadioButtons。如果您这样做，它将重新渲染output$table，就像您使用input$selected_detail 一样。话虽如此，以下作品......有点。只要您选择一个选项卡，它就会关闭选项卡，因为 Input$tabs 设置为 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)