R 闪亮的仪表板菜单项和子项反应输出显示在一个选项卡中

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)具有"浏览"按钮正在加载数据并将其显示在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"))  
)
)

编辑

这样，整个表将不再显示。为了解决这个问题，我的建议是为整个表添加一个新的menuSubItemdashboardSidebar，如下所示：

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