如何在 navbarpage 布局中插入值框？

Question

我正在尝试将 valueBox 添加到在 navbarpage 布局中创建的 shiny 应用程序，我知道阀箱是 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)

如何在 navbarpage 布局中插入值框？

how to insert valuebox inside navbarpage layout?

r

shiny

shinydashboard

flexdashboard