R shinydashboard:各种菜单子项的动态和静态选项卡项的混合
R shinydashboard: Mix of dynamic and static tabItems for various menusubitems
我正在构建一个包含三个部分的应用程序:
- 概述
- 详细结果
- 帮助
详细结果部分应显示多个子项目的结果,一次一个。
我对结果部分成为单个选项卡感兴趣,因为我不想为每个子项的每个选项卡编写代码。每个子项目都有相同的,在示例中是直方图。
当我 运行 这个例子时,我丢失了子项的 ID。
是否可以采用这样的布局但保留所有菜单项和菜单子项的 ID?
很高兴看到替代方法。
下面是一个说明问题的例子。该解决方案将在概览中显示 table,在任何子项的结果中显示直方图,在帮助部分显示 HTML 输出。
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "SideBarMENU",
menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
menuItem("Results", startExpanded = TRUE,
menuSubItem("Sepal.Length", tabName = "RESULTS"),
menuSubItem("Sepal.Width" , tabName = "RESULTS"),
menuSubItem("Petal.Length", tabName = "RESULTS"),
menuSubItem("Petal.Width" , tabName = "RESULTS")
),
menuItem("Help", tabName = "HELP")
)
),
dashboardBody(
tabItems(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
),
tabItem("RESULTS",
box("Results box",
plotOutput("results")
)
),
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
)
server <- function(input, output, session) {
data <- reactive({
print(input$SideBarMENU)
if(input$SideBarMENU %in% names(iris)){
iris[[input$SideBarMENU]]
} else {
rnorm(100, 1000, 10)
}
})
output$results <- renderPlot({
hist(data())
})
output$overview <- renderTable({
head(iris)
})
output$help <- renderText({
HTML("A wiki is a website on which users collaboratively.....")
})
}
shinyApp(ui, server)
基本上,您需要两个组件:
动态内容/剧情
动态仪表板正文
第一部分比较简单:
1.动态内容/情节
您可以按照其他一些 SO 帖子中的说明在循环中创建输出:
lapply(nms, function(name){
output[[name]] <- renderUI ({
box("Results Box", plotOutput(paste0("plot_", name)))
})
output[[paste0("plot_", name)]] <- renderPlot({
hist(iris[[input$SideBarMENU]], main = "")
})
})
2。动态仪表板正文
这部分比较复杂。您需要动态 tabitems()
并且它们必须与静态部分混合。为了将 tabitem()
的列表移交给 tabitems()
您可以使用 do.call(tabItems, ..)
进行转换,请参阅下面的 link。要将它们与静态元素组合,请将静态元素转换为 list()
元素并将它们全部组合在 list()
中,然后再调用 do.call(tabItems, ..)
.
output$tabItms <- renderUI ({
itemsDyn <- lapply(nms, function(name){
tabItem(tabName = name, uiOutput(name))
})
items <- c(
list(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
)
),
itemsDyn,
list(
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
do.call(tabItems, items)
})
可以在这里找到类似的组件:
并在此处循环 tabItems()
:How to make a function in a for loop or lapply loop in a tabItem dashboard shiny。
注:
我修改names(iris)
:
nms <- gsub("[.]", "", names(iris))
names(iris) <- nms
因为选项卡项名称不允许使用点。
可重现的例子:
library(shiny)
library(shinydashboard)
nms <- gsub("[.]", "", names(iris))
names(iris) <- nms
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
uiOutput("menu")
),
dashboardBody(
uiOutput("tabItms")
)
)
server <- function(input, output, session) {
output$tabItms <- renderUI ({
itemsDyn <- lapply(nms, function(name){
tabItem(tabName = name, uiOutput(name))
})
items <- c(
list(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
)
),
itemsDyn,
list(
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
do.call(tabItems, items)
})
lapply(nms, function(name){
output[[name]] <- renderUI ({
box("Results Box", plotOutput(paste0("plot_", name)))
})
output[[paste0("plot_", name)]] <- renderPlot({
hist(iris[[input$SideBarMENU]], main = "")
})
})
output$menu <- renderUI({
sidebarMenu(id = "SideBarMENU",
menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
menuItem("Results", id = "resultChoice", startExpanded = TRUE,
lapply(nms, function(name) {
menuSubItem(name, tabName = name)
})
),
menuItem("Help", tabName = "HELP")
)
})
output$overview <- renderTable({
head(iris)
})
output$help <- renderText({
HTML("A wiki is a website on which users collaboratively.....")
})
}
shinyApp(ui, server)
我正在构建一个包含三个部分的应用程序:
- 概述
- 详细结果
- 帮助
详细结果部分应显示多个子项目的结果,一次一个。
我对结果部分成为单个选项卡感兴趣,因为我不想为每个子项的每个选项卡编写代码。每个子项目都有相同的,在示例中是直方图。
当我 运行 这个例子时,我丢失了子项的 ID。 是否可以采用这样的布局但保留所有菜单项和菜单子项的 ID?
很高兴看到替代方法。
下面是一个说明问题的例子。该解决方案将在概览中显示 table,在任何子项的结果中显示直方图,在帮助部分显示 HTML 输出。
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(id = "SideBarMENU",
menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
menuItem("Results", startExpanded = TRUE,
menuSubItem("Sepal.Length", tabName = "RESULTS"),
menuSubItem("Sepal.Width" , tabName = "RESULTS"),
menuSubItem("Petal.Length", tabName = "RESULTS"),
menuSubItem("Petal.Width" , tabName = "RESULTS")
),
menuItem("Help", tabName = "HELP")
)
),
dashboardBody(
tabItems(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
),
tabItem("RESULTS",
box("Results box",
plotOutput("results")
)
),
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
)
server <- function(input, output, session) {
data <- reactive({
print(input$SideBarMENU)
if(input$SideBarMENU %in% names(iris)){
iris[[input$SideBarMENU]]
} else {
rnorm(100, 1000, 10)
}
})
output$results <- renderPlot({
hist(data())
})
output$overview <- renderTable({
head(iris)
})
output$help <- renderText({
HTML("A wiki is a website on which users collaboratively.....")
})
}
shinyApp(ui, server)
基本上,您需要两个组件:
动态内容/剧情
动态仪表板正文
第一部分比较简单:
1.动态内容/情节
您可以按照其他一些 SO 帖子中的说明在循环中创建输出:
lapply(nms, function(name){
output[[name]] <- renderUI ({
box("Results Box", plotOutput(paste0("plot_", name)))
})
output[[paste0("plot_", name)]] <- renderPlot({
hist(iris[[input$SideBarMENU]], main = "")
})
})
2。动态仪表板正文
这部分比较复杂。您需要动态 tabitems()
并且它们必须与静态部分混合。为了将 tabitem()
的列表移交给 tabitems()
您可以使用 do.call(tabItems, ..)
进行转换,请参阅下面的 link。要将它们与静态元素组合,请将静态元素转换为 list()
元素并将它们全部组合在 list()
中,然后再调用 do.call(tabItems, ..)
.
output$tabItms <- renderUI ({
itemsDyn <- lapply(nms, function(name){
tabItem(tabName = name, uiOutput(name))
})
items <- c(
list(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
)
),
itemsDyn,
list(
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
do.call(tabItems, items)
})
可以在这里找到类似的组件:tabItems()
:How to make a function in a for loop or lapply loop in a tabItem dashboard shiny。
注:
我修改names(iris)
:
nms <- gsub("[.]", "", names(iris))
names(iris) <- nms
因为选项卡项名称不允许使用点。
可重现的例子:
library(shiny)
library(shinydashboard)
nms <- gsub("[.]", "", names(iris))
names(iris) <- nms
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
uiOutput("menu")
),
dashboardBody(
uiOutput("tabItms")
)
)
server <- function(input, output, session) {
output$tabItms <- renderUI ({
itemsDyn <- lapply(nms, function(name){
tabItem(tabName = name, uiOutput(name))
})
items <- c(
list(
tabItem("OVERVIEW",
box("Overview box",
tableOutput("overview"))
)
),
itemsDyn,
list(
tabItem("HELP",
box("HELP box",
textOutput("help"))
)
)
)
do.call(tabItems, items)
})
lapply(nms, function(name){
output[[name]] <- renderUI ({
box("Results Box", plotOutput(paste0("plot_", name)))
})
output[[paste0("plot_", name)]] <- renderPlot({
hist(iris[[input$SideBarMENU]], main = "")
})
})
output$menu <- renderUI({
sidebarMenu(id = "SideBarMENU",
menuItem("Overview", tabName = "OVERVIEW", selected = TRUE),
menuItem("Results", id = "resultChoice", startExpanded = TRUE,
lapply(nms, function(name) {
menuSubItem(name, tabName = name)
})
),
menuItem("Help", tabName = "HELP")
)
})
output$overview <- renderTable({
head(iris)
})
output$help <- renderText({
HTML("A wiki is a website on which users collaboratively.....")
})
}
shinyApp(ui, server)