闪亮仪表板的选项卡相关输入

Question

我正面临闪亮仪表板的问题。我正在尝试创建一个简单的仪表板，左侧有两个 tabItems。每个 tabItem 都有其特定的控件集和绘图。但是我可能在服务器端遗漏了一些东西来将输入链接到选项卡，因为第二个选项卡的控件表现得很奇怪。任何帮助将非常感激。这是我的代码

library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))

sidebar <- dashboardSidebar(
  sidebarMenu(id = 'sidebarMenu',
    menuItem("tab 1", tabName = "tab1", icon = icon("dashboard")),
    menuItem("tab 2", icon = icon("th"), tabName = "tab2")
  )
)

body <- dashboardBody(
          tabItems(
            tabItem(tabName = "tab1",
              fluidRow(
                box(title = "Controls",
                    checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
                box(plotOutput("plot1"), width = 8)
             )
           ),

          tabItem(tabName = "tab2",
             fluidRow(
               box(title = "Controls",
                   checkboxGroupInput('group', 'group:', c(1, 3, 6), selected = 6, inline = TRUE), width = 4),
               box(plotOutput("plot2"), width = 8)
             )
          )
       )
    )

 # Put them together into a dashboardPage
 ui <- dashboardPage(
 dashboardHeader(title = "test tabbed inputs"),
 sidebar,
 body,
 skin = 'green'
 )

server <- function(input, output) {
   output$plot1 <- renderPlot({
   plotData <- data[group %in% input$group]
   p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
   print(p)
   })
   output$plot2 <- renderPlot({
   plotData <- data[group %in% input$group]
   p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()
   print(p)
   })
}

shinyApp(ui, server)

当我在第一个选项卡中更改输入时，它也会在第二个选项卡中更改，然后当我尝试将其更改回来时，通常什么都没有发生，或者它只是表现得很奇怪。我想我需要以某种方式指定将输入绑定到 tabItems 但找不到这样做的好例子。任何帮助将不胜感激。

谢谢， 阿信

Answer 1

要处理动态数量的选项卡或其他小部件，请在 server.R 和 renderUI 中创建它们。使用list 存储选项卡，使用do.call 函数应用tabItems 函数。侧边栏也是如此。

我认为我下面的代码会产生您的期望。

library(shiny)
library(shinydashboard)
library(data.table)
library(ggplot2)
data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))

sidebar <- dashboardSidebar(
  uiOutput("Sidebar")
)

body <- dashboardBody(
  uiOutput("TABUI")
)

# Put them together into a dashboardPage
ui <- dashboardPage(
  dashboardHeader(title = "test tabbed inputs"),
  sidebar,
  body,
  skin = 'green'
)

server <- function(input, output) {

  ntabs <- 3
  tabnames <- paste0("tab", 1:ntabs) # "tab1", "tab2", ...
  checkboxnames <- paste0(tabnames, 'group') # "tab1group", "tab2group", ...
  plotnames <- paste0("plot", 1:ntabs) # "plot1", "plot2", ...

  output$Sidebar <- renderUI({
    Menus <- vector("list", ntabs)
    for(i in 1:ntabs){
      Menus[[i]] <-   menuItem(tabnames[i], tabName = tabnames[i], icon = icon("dashboard"), selected = i==1)
    }
    do.call(function(...) sidebarMenu(id = 'sidebarMenu', ...), Menus)
  })

  output$TABUI <- renderUI({
    Tabs <- vector("list", ntabs)
    for(i in 1:ntabs){
      Tabs[[i]] <- tabItem(tabName = tabnames[i],
                     fluidRow(
                       box(title = "Controls", 
                           checkboxGroupInput(checkboxnames[i], 'group:', c(1, 3, 6), selected = 6, inline = TRUE), 
                           width = 4),
                       box(plotOutput(paste0("plot",i)), width = 8)
                     )
      )
    }
    do.call(tabItems, Tabs)
  })

  RV <- reactiveValues()
  observe({
    selection <- input[[paste0(input$sidebarMenu, 'group')]]
    RV$plotData <- data[group %in% selection]
  })

  for(i in 1:ntabs){
    output[[plotnames[i]]] <- renderPlot({
      plotData <-  RV$plotData 
      p <- ggplot(plotData, aes(x = x, y = value, colour = factor(group))) + 
        geom_line() + geom_point()  
      print(p)
    })
  }

}

shinyApp(ui, server)

请注意，我将“绘图数据”放在反应列表中。否则，如果我这样做：

output[[plotnames[i]]] <- renderPlot({
   selection <- input[[paste0(input$sidebarMenu, 'group')]]
   plotData <- data[group %in% selection]
   ...

每次您返回标签时，情节都会发生反应（尝试了解我的意思）。