how to insert valuebox inside navbarpage layout?

Question

I'm trying to add valueBox to shiny app created in navbarpage layout, I know that valve boxes are part of the shinydashboard package but this app made me wonder how should I achieve this below is an image of the app, here is the live app

here is my trial using the below code the widgets are overlapping and effect the navbar appearance on all tabpanels.

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

score 13 · Accepted Answer · answered Dec 30 '19 at 08:43

You can use shinyWidgets::useShinydashboard to do that, with your example it gives :

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)

score 0 · Answer 2 · answered Jan 11 '23 at 19:55

I crossed this a few years after this question was asked. This is what I was able to come up with which is pretty close to to what the OP asked for (of course without going into the detail of the plot, inputs, valueboxes, ect).

Hope it helps anyone else.

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

# ui
ui <- navbarPage(
  title = "Claims ML",
 
  ###### Here : insert shinydashboard dependencies ######
  header = tagList(
    useShinydashboard()
  ),
  #######################################################
  tabPanel("Overview",
           fluidRow(    
           column(width=4,
                  # Metrics Filters
                  fluidRow(
                    box(title="Metrics",
                        width = 12,
                        status = "primary",
                        solidHeader = TRUE,
                        sliderInput("slider", "Slider input:", 1, 100, 50),
                        textInput("text", "Text input:")
                      )
                    ),
                  fluidRow(
                    box(title="Claim Filters",
                        width = 12,
                        status = "primary",
                        solidHeader = TRUE,
                        collapsible = TRUE,
                        sliderInput("slider2", "Slider input:", 1, 100, 50),
                        textInput("text2", "Text input:"))
                    )
                  ),
           column(width=8,
                  # Metrics Filters
                  fluidRow(tags$head(tags$style(HTML('.box{-webkit-box-shadow: none; border-top: none; -moz-box-shadow: none;box-shadow: none;}'))),
                    box(width =12,
                        valueBox(10 * 2, "Value Box 1", icon = icon("credit-card")),
                        valueBox(10 * 2, "Value Box 2", icon = icon("download")),
                        valueBox(10 * 2, "Value Box 3", icon = icon("fa-grill-hot"))
                       
                    )
                  ),
                  fluidRow(tags$head(tags$style(HTML('.box{-webkit-box-shadow: none; border-top: none;-moz-box-shadow: none;box-shadow: none;}'))),
                    box(width = 12,
                        plotOutput("plot")
                    )
                  )
           )
           )
  ),
  tabPanel("Summary",
           verbatimTextOutput("summary")
  )
)
 
  # server
  server <- function(input, output) {
   
    output$plot <- renderPlot({
      ggplot(data = diamonds, aes(x=cut, fill = cut)) +
        geom_bar(alpha = 0.8)
    })
   
  }
 
  shinyApp(ui = ui, server = server)

how to insert valuebox inside navbarpage layout?

2 Answers2