如何在navbarpage布局内插入valuebox？

Question

我正在尝试将valueBox添加到以navbarpage布局创建的闪亮应用程序中，我知道阀箱是Shinydashboard程序包的一部分，但是此应用程序让我想知道如何实现该功能 下面是该应用的图片，这是live app

这是我的审判 使用以下代码，小部件会重叠，并影响所有选项卡面板上的导航栏外观。

# Function for adding dependencies
library("htmltools")
addDeps <- function(x) {
  if (getOption("shiny.minified", TRUE)) {
    adminLTE_js <- "app.min.js"
    adminLTE_css <- c("AdminLTE.min.css", "_all-skins.min.css")
  } else {
    adminLTE_js <- "app.js"
    adminLTE_css <- c("AdminLTE.css", "_all-skins.css")
  }

  dashboardDeps <- list(
    htmlDependency("AdminLTE", "2.0.6",
                   c(file = system.file("AdminLTE", package = "shinydashboard")),
                   script = adminLTE_js,
                   stylesheet = adminLTE_css
    ),
    htmlDependency("shinydashboard",
                   as.character(utils::packageVersion("shinydashboard")),
                   c(file = system.file(package = "shinydashboard")),
                   script = "shinydashboard.js",
                   stylesheet = "shinydashboard.css"
    )
  )

  shinydashboard:::appendDependencies(x, dashboardDeps)
}

library("shiny")
# ui 
ui <- navbarPage("test",
                 tabPanel("START",
                              fluidRow(box(width = 12,
                                infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
                                infoBoxOutput("progressBox2"),
                                infoBoxOutput("approvalBox2")
                              )),
                              fluidRow(
                                # Clicking this will increment the progress amount
                                box(width = 4, actionButton("count", "Increment progress"))
                              ),
                          column(6,box(flexdashboard::gaugeOutput("plt1"),width=12, height = "200px",title="Gauge Graph")))



                 ,
                 tabPanel("Summary",
                          verbatimTextOutput("summary")

))
# Attach dependencies
ui <- addDeps(
  tags$body(shiny::navbarPage(ui)
  )
)
# server
server <- function(input, output) {
  output$plt1 <- flexdashboard::renderGauge({
    gauge(56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),gaugeSectors(
      success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
    ))

  })
  output$progressBox2 <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple", fill = TRUE
    )
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow", fill = TRUE
    )
  })
}
# app
shinyApp(ui = ui, server = server)

Answer 1

您可以使用shinyWidgets::useShinydashboard来完成此操作，示例如下所示：

library(shiny)
library(shinyWidgets)
library(shinydashboard)

# ui 
ui <- navbarPage(
  title = "test",

  ###### Here : insert shinydashboard dependencies ######
  header = tagList(
    useShinydashboard()
  ),
  #######################################################

  tabPanel(
    "START",
    fluidRow(box(width = 12,
                 infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
                 infoBoxOutput("progressBox2"),
                 infoBoxOutput("approvalBox2")
    )),
    fluidRow(
      # Clicking this will increment the progress amount
      box(width = 4, actionButton("count", "Increment progress"))
    ),
    column(
      6,
      box(flexdashboard::gaugeOutput("plt1"),width=12, height = "200px",title="Gauge Graph")
    )
  ),
  tabPanel("Summary",
           verbatimTextOutput("summary")

  )
)

# server
server <- function(input, output) {
  output$plt1 <- flexdashboard::renderGauge({
    flexdashboard::gauge(
      56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),
      flexdashboard::gaugeSectors(
        success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
      )
    )

  })
  output$progressBox2 <- renderInfoBox({
    infoBox(
      "Progress", paste0(25 + input$count, "%"), icon = icon("list"),
      color = "purple", fill = TRUE
    )
  })
  output$approvalBox2 <- renderInfoBox({
    infoBox(
      "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
      color = "yellow", fill = TRUE
    )
  })
}
# app
shinyApp(ui = ui, server = server)