为什么Shiny不会在tabItem中呈现这些信息框
Posted
tags:
篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了为什么Shiny不会在tabItem中呈现这些信息框相关的知识,希望对你有一定的参考价值。
我正在构建我的第一个Shiny-App,我有一个关于TabItems的问题。这是我必须完成其工作的应用程序的屏幕截图。如果我单击menuSubItem“area1”,则plot1将显示在主面板中,并显示一些信息框。我想在area2和area3的tabItems中有这个布局,但它不起作用。闪亮不会渲染它。
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)
任何帮助是极大的赞赏!我已经尝试了几个小时的改变,不再有任何想法了。
答案
你不能在两个输出中使用一个元素(“ordersbox”)
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("ordersbox1", width = NULL),
infoBoxOutput("progressBox1", width = NULL),
infoBoxOutput("approvalBox1", width = NULL),
infoBoxOutput("BonusBox1", 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
)
})
output$ordersbox1 <- renderInfoBox({
infoBox(
"KPI 1", "120", icon = icon("users", lib = "font-awesome"),
color = "light-blue", fill =TRUE, width = 3
)
})
# 2. Box
output$progressBox1 <- 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$approvalBox1 <- renderInfoBox({
infoBox(
"KPI 2", "120", icon = icon("check-square", lib = "font-awesome"),
color = "yellow", fill =TRUE,width = 3
)
})
# 4. Box
output$BonusBox1 <- 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)
以上是关于为什么Shiny不会在tabItem中呈现这些信息框的主要内容,如果未能解决你的问题,请参考以下文章
如何使 tabItem 仪表板中的 for 循环或 lapply 循环中的函数闪亮
当我有选择 > 1000 时,Shiny 不会向我显示整个 selectInput