为什么Shiny不会在tabItem中呈现这些信息框

Question

我正在构建我的第一个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)

但是，如果我添加注释代码，那么闪亮不再渲染：

任何帮助是极大的赞赏！我已经尝试了几个小时的改变，不再有任何想法了。

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