一个选项卡中显示了R Shinydashboard菜单项和子项的无功输出

Question

我对Shiny ， shinydashboard和DT很shinydashboard 。 我正在尝试构建一个简单的应用程序，其中从.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 ）具有“浏览”按钮，正在加载数据并将其显示在DT表中。 第二个菜单项（ My Items ）中的子项仅在加载数据时才显示输出。 它们中的每一个都应显示标题和DT表，其中包含已加载数据集中的两个变量。 但是，加载数据时，所有输出均显示在第一个选项卡中，而第二个菜单项的子项的选项卡仍为空。

当没有无功输入时（ 如在此简单示例中 ），一切正常，但对于无功输出，情况似乎有所不同。 显然，有些事情我还是无法理解。 有人可以帮忙吗？

这是应用程序：

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"))  
  )
)

编辑

这样做，不再显示完整表。 为解决此问题，我的建议是在dashboardSidebar为整个表添加一个新的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")
              )
  )
)