为什么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)
但是，如果我添加注释代码，那么闪亮不再渲染：
非常感谢任何帮助！我已经尝试了几个小时的改变，不再有任何想法了。
1 个答案:
答案 0 :(得分：1)
您不能在两个输出中使用一个元素（“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)
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？