R shinydashboard 菜单项和子项反应输出显示在一个选项卡中

Question

我是 Shiny、shinydashboard 和 DT 的新手。我正在尝试构建一个简单的应用程序，我从 .csv 文件加载数据，生成如下：

x <- data.table(VAR1 = rnorm(n = 20, mean = 10, sd = 2), VAR2 = rnorm(n = 20, mean = 100, sd = 20), VAR3 = 1:20, VAR4 = 21:40)
write.csv(x = x, file = "/tmp/test_data.csv")

我构建了一个应用程序，其中有一个包含两个菜单项（Data 和 My Items）的仪表板，第二个包含三个子项。第一个菜单项 (Data) 有 "Browse" 按钮正在加载数据并将其显示在 DT table 中。第二个菜单项 (My Items) 中的子项应仅在加载数据时显示输出。他们每个人都应该显示一个标题和一个 DT table 以及加载数据集中的两个变量。但是，加载数据时，所有输出都显示在第一个选项卡中，第二个菜单项的子项的选项卡保持为空。

当没有无功输入 (like in this simple example) 时一切正常，但有无功输出时情况似乎有所不同。显然，还有一些我无法理解的事情。有人可以帮忙吗？

这是应用程序：

library(shiny)
library(shinydashboard)
library(data.table)
library(DT)

ui <- dashboardPage(title = "Dashboard Title",
                    dashboardHeader(title = "My Dashboard"),
                    dashboardSidebar(
                      sidebarMenu(id = "menu",
                                  menuItem(text = "Data", icon = icon("database"), tabName = "inputData",
                                           fileInput(inputId = "file", label = "Choose CSV File",
                                                     multiple = TRUE,
                                                     accept = ".csv")),
                                  menuItem(text = "My Items", tabName = "items", icon = icon("book"),
                                           menuSubItem(text = "Item 1", tabName = "item01"),
                                           menuSubItem(text = "Item 2", tabName = "item02"),
                                           menuSubItem(text = "Item 3", tabName = "item03")
                                  )
                      )
                    ),
                    dashboardBody(
                      tabItems(
                        tabItem(tabName = "inputData", class = "active",
                                h1(textOutput("heading")),
                                dataTableOutput("loaded.data")),
                        tabItem(tabName = "items", h1(textOutput("heading0")), class = "active",
                                tabItem(tabName = "item01", class = "active", h1(textOutput("heading1")), dataTableOutput("table1")),
                                tabItem(tabName = "item02", class = "active", h1(textOutput("heading2")), dataTableOutput("table2")),
                                tabItem(tabName = "item03", class = "active", h1(textOutput("heading3")), dataTableOutput("table3"))
                        )
                      )
                    )
)

server <- function(input, output) {
  # Load the data and assign it to a reactive object
  df <- reactive({
    inFile <- input$file
    if(is.null(inFile)) {
      return(NULL)
    } else {
      tbl <- fread(input$file$datapath, sep = ",", quote = '"', stringsAsFactors = TRUE)
      return(tbl)
    }
  })

  output$heading <- renderText({
    if(is.null(df())) {
      return(NULL)
    } else {
      return("Data loaded")
    }
  })

  output$loaded.data <- renderDT({
    if(is.null(df())) {
      return(NULL)
    } else {
      df()
    }
  })

  output$heading0 <- renderText({
    if(is.null(df())) {
      return(NULL)
    } else {
      return("In the sub-menus below you will find the tables")
    }
  })

  output$heading1 <- renderText({
    if(is.null(df())) {
      return(NULL)
    } else {
      return("Heading item 1")
    }
  })

  output$table1 <- renderDT({
    if(is.null(df())) {
      return(NULL)
    } else {
      return(df()[ , c("VAR1", "VAR2")])
    }
  })

  output$heading2 <- renderText({
    if(is.null(df())) {
      return(NULL)
    } else {
      return("Heading item 2")
    }
  })

  output$table2 <- renderDT({
    if(is.null(df())) {
      return(NULL)
    } else {
      return(df()[ , c("VAR2", "VAR3")])
    }
  })

  output$heading3 <- renderText({
    if(is.null(df())) {
      return(NULL)
    } else {
      return("Heading item 3")
    }
  })

  output$table3 <- renderDT({
    if(is.null(df())) {
      return(NULL)
    } else {
      return(df()[ , c("VAR2", "VAR3")])
    }
  })

}

shinyApp(ui, server)

Answer 1

我认为你应该这样写你的dashboardBody：

dashboardBody(
  tabItems(
    tabItem(tabName = "inputData", 
            h1(textOutput("heading")),
            dataTableOutput("loaded.data")),
    tabItem(tabName = "item01", 
            h1(textOutput("heading1")), 
            dataTableOutput("table1")),
    tabItem(tabName = "item02", 
            h1(textOutput("heading2")), 
            dataTableOutput("table2")),
    tabItem(tabName = "item03",
            h1(textOutput("heading3")), 
            dataTableOutput("table3"))  
  )
)

编辑

这样做，完整的 table 就不会再出现了。为了解决这个问题，我的建议是在dashboardSidebar中为完整的table添加一个新的menuSubItem，如下所示：

dashboardSidebar(
  sidebarMenu(id = "menu",
              menuItem(text = "Data", icon = icon("database"), 
                       fileInput(inputId = "file", label = "Choose CSV File",
                                 multiple = TRUE,
                                 accept = ".csv"),
                       menuSubItem(text = "Full Table", tabName = "inputData")
              ),
              menuItem(text = "My Items",  icon = icon("book"),
                       menuSubItem(text = "Item 1", tabName = "item01"),
                       menuSubItem(text = "Item 2", tabName = "item02"),
                       menuSubItem(text = "Item 3", tabName = "item03")
              )
  )
)

或者更好一点（恕我直言）：

dashboardSidebar(
  sidebarMenu(id = "menu",
              menuItem(text = "Data", icon = icon("database"), 
                       fileInput(inputId = "file", label = "Choose CSV File",
                                 multiple = TRUE,
                                 accept = ".csv")
              ),
              menuItem(text = "My Items",  icon = icon("book"),
                       menuSubItem(text = "Full Table", tabName = "inputData"),
                       menuSubItem(text = "Item 1", tabName = "item01"),
                       menuSubItem(text = "Item 2", tabName = "item02"),
                       menuSubItem(text = "Item 3", tabName = "item03")
              )
  )
)

R shinydashboard 菜单项和子项反应输出显示在一个选项卡中

R shinydashboard menu items and subitems reactive output is shown in one tab

r

output

shinydashboard

dt

reactive