使用自己的内容创建动态选项卡

Question

我正在尝试创建一个动态创建不同选项卡的应用程序，其中有一个根据变量过滤的初始表版本（在CheckboxGroupInput 选择的所有选项中）。

例如，如果我尝试使用表 iris，其中有一个变量 Species 采用 3 种模式 virginita，setosa 和 versicolor，然后我想获得第一个标签，其中包含 Species = virginita 的观察结果，第二个标签是 Species = setosa 等...

我在这个论坛上找到了一个动态创建选项卡的解决方案，但在所有这些选项卡中，获得的数据集是由最后选择的输入过滤的数据集（这里是 versicolor）。

我怀疑lapply 有问题，但我是R 的新手，而且很闪亮，我似乎找不到解决方案。

我们将不胜感激！

谢谢大家！

library(shiny)

ui <- pageWithSidebar(
    headerPanel = headerPanel('iris'),
    sidebarPanel = sidebarPanel(checkboxGroupInput("filter","Choices",c("virginita","setosa","versicolor"), selected=c("virginita","setosa","versicolor"))
    ),

    mainPanel(uiOutput("my_tabs"))
)

server <- function(input, output, session) {
    df = iris

    output$my_tabs = renderUI({

        dt <- list()

        for ( i in 1:3) {
            output[[paste0("tab",as.character(i))]] <- DT::renderDataTable ({
                dt2 <- subset(df, Species==input$filter[i]) 
                return(dt2)
            })
            dt[[i]] <- DT::DTOutput(paste0("tab",as.character(i)))
        }

        criteria <- input$filter
        n=length(criteria)
        myTabs = lapply(1:n, function(j){
            tabPanel(criteria[j],
                     renderUI(dt[[j]])
            )

        })
        do.call(tabsetPanel, myTabs)
    })

}


runApp(list(ui = ui, server = server))

Answer 1

在闪亮的应用程序中使用 for 循环可能会出现问题：

https://chasemc.github.io/post/the-subtleties-of-shiny-reactive-programming-lapply-and-for-loops/

改为使用lapply。

另外，我会将您为不同选项卡动态创建的output 分离为observe 表达式（尽管您可以将它放在output$my_tabs 的顶部）。

此外，我注意到virginica 在ui 中拼写错误。否则，这包括您的大部分相同代码并且似乎可以工作。

library(shiny)
library(DT)

ui <- pageWithSidebar(
  headerPanel = headerPanel('iris'),
  sidebarPanel = sidebarPanel(checkboxGroupInput("filter","Choices",c("virginica","setosa","versicolor"), 
                                                 selected=c("virginica","setosa","versicolor"))
  ),
  mainPanel(uiOutput("my_tabs"))
)

server <- function(input, output, session) {
  df = iris

  output$my_tabs = renderUI({
    myTabs = lapply(1:length(input$filter), function(i) {
      tabPanel(input$filter[i],
               DT::DTOutput(paste0("tab",i))       
      )
    })
    do.call(tabsetPanel, myTabs)
  })

  observe(
    lapply(1:length(input$filter), function(i) {
      output[[paste0("tab",i)]] <- DT::renderDataTable({
        subset(df, Species == input$filter[i])
      })
    })  
  ) 
}

runApp(list(ui = ui, server = server))