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

Question

I am fairly new to Shiny , shinydashboard and DT . I am trying to build a simple application where I load data from .csv file, generated like this:

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

I have built the application where I have a dashboard with two menu items ( Data and My Items ), the second one has three subitems. The first menu item ( Data ) has "Browse" button is loading the data and show it in a DT table. The subitems in the second menu item ( My Items ) should show output only when the data is loaded. Each of them should show a heading and a DT table with two of the variables in the loaded data set. However, when the data is loaded, all the outputs are shown in the first tab and the tabs for the subitems of the second menu item remain empty.

When there is no reactive input ( like in this simple example ) everything works fine, but with reactive output things seem different. Apparently, there are still things that I fail to understand. Can someone help?

Here is the application:

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

I think you should write your dashboardBody as follows:

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

EDIT

Doing so, the full table does not appear anymore. To solve this issue, my proposal is to add a new menuSubItem in dashboardSidebar for the full table as follows:

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

Or a bit nicer (IMHO):

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