Search code examples
rshinyshinydashboardflexdashboard

how to insert valuebox inside navbarpage layout?


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 image

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)

Solution

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