Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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)
like image 930
John Avatar asked Dec 29 '19 08:12

John


1 Answers

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)
like image 151
Victorp Avatar answered Oct 31 '22 01:10

Victorp