# NOT RUN {
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of boxes
body <- dashboardBody(
# infoBoxes
fluidRow(
infoBox(
"Orders", uiOutput("orderNum2"), "Subtitle", icon = icon("credit-card")
),
infoBox(
"Approval Rating", "60%", icon = icon("line-chart"), color = "green",
fill = TRUE
),
infoBox(
"Progress", uiOutput("progress2"), icon = icon("users"), color = "purple"
)
),
# valueBoxes
fluidRow(
valueBox(
uiOutput("orderNum"), "New Orders", icon = icon("credit-card"),
href = "http://google.com"
),
valueBox(
tagList("60", tags$sup(style="font-size: 20px", "%")),
"Approval Rating", icon = icon("line-chart"), color = "green"
),
valueBox(
htmlOutput("progress"), "Progress", icon = icon("users"), color = "purple"
)
),
# Boxes
fluidRow(
box(status = "primary",
sliderInput("orders", "Orders", min = 1, max = 2000, value = 650),
selectInput("progress", "Progress",
choices = c("0%" = 0, "20%" = 20, "40%" = 40, "60%" = 60, "80%" = 80,
"100%" = 100)
)
),
box(title = "Histogram box title",
status = "warning", solidHeader = TRUE, collapsible = TRUE,
plotOutput("plot", height = 250)
)
),
# Boxes with solid color, using `background`
fluidRow(
# Box with textOutput
box(
title = "Status summary",
background = "green",
width = 4,
textOutput("status")
),
# Box with HTML output, when finer control over appearance is needed
box(
title = "Status summary 2",
width = 4,
background = "red",
uiOutput("status2")
),
box(
width = 4,
background = "light-blue",
p("This is content. The background color is set to light-blue")
)
)
)
server <- function(input, output) {
output$orderNum <- renderText({
prettyNum(input$orders, big.mark=",")
})
output$orderNum2 <- renderText({
prettyNum(input$orders, big.mark=",")
})
output$progress <- renderUI({
tagList(input$progress, tags$sup(style="font-size: 20px", "%"))
})
output$progress2 <- renderUI({
paste0(input$progress, "%")
})
output$status <- renderText({
paste0("There are ", input$orders,
" orders, and so the current progress is ", input$progress, "%.")
})
output$status2 <- renderUI({
iconName <- switch(input$progress,
"100" = "ok",
"0" = "remove",
"road"
)
p("Current status is: ", icon(iconName, lib = "glyphicon"))
})
output$plot <- renderPlot({
hist(rnorm(input$orders))
})
}
shinyApp(
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(),
body
),
server = server
)
}
# }
Run the code above in your browser using DataLab