Question

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

例如，如果我尝试使用表 iris ，其中有一个变量 Species ，采用了三种形式 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))

创建具有自己内容的动态标签

1 个答案: