【发布时间】：2018-06-06 15:33:18
【问题描述】：
我目前正在构建我的第一个 Shiny-App，但我遇到了关于 TabItems 的问题。这是我要做的应用程序的屏幕截图。如果我单击 menuSubItem “area1”，然后 plot1 会显示在主面板中，以及一些信息框。我也想在 area2 和 area3 的 tabItems 中有这个布局，但它不起作用。 Shiny 不会渲染它。
library("shiny")
library("shinydashboard")
library("tidyverse")
library("dashboardthemes")
library("ggthemes")
library("DT")
library("lubridate")
#-----------------------------------------------------
ui <- dashboardPage(
#skin = "black",
dashboardHeader(title = "Basic dashboard", titleWidth = 450,
dropdownMenu(type = "notifications",
notificationItem(text="test 1", icon("check")),
notificationItem(text="test 2", icon("refresh"),status = "warning"))),
dashboardSidebar(width = 150, collapsed = FALSE, #disable = TRUE um die Sidebar auszuschalten
sidebarMenu(id = "tabs",
menuItem("Areas", icon = icon("bar-chart-o"), startExpanded = TRUE),
menuSubItem("area1", tabName = "tab1", icon = shiny::icon("clipboard-check",lib = "font-awesome"), selected =TRUE),
menuSubItem("area2", tabName = "tab2", icon = shiny::icon("pallet", lib = "font-awesome")),
menuSubItem("area3", tabName = "tab3", icon = shiny::icon("dolly-flatbed", lib = "font-awesome")),
dateInput(inputId = 'dateselection',
label = 'Show this date',
value = Sys.Date(),
language = "de",
max = Sys.Date(),
startview = "year",
weekstart = 1, width = 450),
menuItem("Table", tabName = "table1", icon = icon("table"))
)
),
dashboardBody(
### changing theme
shinyDashboardThemes(theme = "grey_dark"),
mainPanel(
tabItems(
tabItem(tabName = "tab1", class='active',
h2("area 1"),
fluidRow(
column(width = 8,
tabItem(tabName = "tab1", plotOutput("plot1"), width = 8)
),
column(width = 4,
tabItem(tabName = "tab1", width = 4,
infoBoxOutput("ordersbox", width = NULL),
infoBoxOutput("progressBox", width = NULL),
infoBoxOutput("approvalBox", width = NULL),
infoBoxOutput("BonusBox", width = NULL))
)
)
),
tabItem(tabName = "tab3", #class='active',
h2("area 2"),width = 12,
fluidRow(
column(width = 8,
tabItem(tabName = "tab3", plotOutput("plot3"), width = 8)
)#, # If i uncomment this, the app doesn´t render anymore!!! Why is that so?
# column(width = 4,
# tabItem(tabName = "tab3", width = NULL,
# infoBoxOutput("ordersbox", width = NULL),
# infoBoxOutput("progressBox", width = NULL),
# infoBoxOutput("approvalBox", width = NULL),
# infoBoxOutput("BonusBox", width = NULL))
# )
)
),
tabItem(tabName = "table1",
h2("Example Table"),
width = 8,
fluidRow(
column(width = 8,
DT::DTOutput('mytable1')))), #dataTableOutput
tabItem(tabName = "tab2",
h2("area 3"),
width = 8,
fluidRow(
column(width = 8,
plotOutput("plot2"))))
) #tabItems
) #main Panel
) #dashboard body
) #UI
server <- function(input, output, session){
# 1. Box
output$ordersbox <- renderInfoBox({
infoBox(
"KPI 1", "120", icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 3
)
})
# 2. Box
output$progressBox <- renderInfoBox({
invalidateLater(as.integer(1000))
infoBox(
"Time",
paste(format(Sys.time(), "%H:%M:%S"), "h"),
icon = icon("time", lib = "glyphicon"),
color = "teal", fill =TRUE, width = 3
)
})
# 3. Box
output$approvalBox <- renderInfoBox({
infoBox(
"KPI 2", "120", icon = icon("check-square", lib = "font-awesome"),
color = "yellow", fill =TRUE,width = 3
)
})
# 4. Box
output$BonusBox <- renderInfoBox({
infoBox(
"KPI 3", "110", icon = icon("info-circle", lib = "font-awesome"),
color = "red", fill =TRUE, width = 3
)
})
# time
output$currentTime <- renderText({
invalidateLater(as.integer(1000))
paste("The current time is", Sys.time())
})
# Table
output$mytable1 <- DT::renderDT({
DT::datatable(mpg)
})
# Plot1
output$plot1 <- renderPlot({
ggplot(mpg, aes(displ, hwy, colour = class)) + geom_point() + labs(title ="Plot 1")
})
# Plot2
output$plot2 <- renderPlot({
ggplot(mpg, aes(displ, hwy, colour = class)) + geom_point() + labs(title ="Plot 2")
})
# Plot3
output$plot3 <- renderPlot({
ggplot(mpg, aes(displ, hwy)) + geom_col() + labs(title ="Plot 3")
})
}
shinyApp(ui, server)
非常感谢任何帮助！我已经尝试了几个小时的更改，但没有任何想法。
【问题讨论】：
标签： r shiny shinydashboard