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)
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With