Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #
- # This Shiny web application demonstrates the use of custom image files
- # in place of icons for value boxes in Shiny Dashboard by overriding two
- # functions:
- #
- # 'icon' from the shiny package and 'valueBox' from the shinydashboard package.
- #
- # Each function adds minimal, specific additional handling of image files.
- # Note: A custom css file must also be included so that value boxes can
- # display the icons. For that reason, do not expect images in place of icons to
- # work elsewhere in shiny or shinydashboard.
- # Motivation: libraries like font awesome and glyphicon cannot be expected to
- # provide a substantial suite of icons tailored to probability and statistics
- # or many other subjects. Examples here use seven custom icons for inspiration,
- # which are simply tiny png files of native R plots. These png files must be
- # placed in the app's www/ directory.
- #
- library(shiny)
- library(shinydashboard)
- library(purrr)
- ui <- dashboardPage(
- dashboardHeader(title="Custom Icons"),
- dashboardSidebar(
- sidebarMenu(
- menuItem("Light icons", tabName = "light"),
- menuItem("Dark icons", tabName = "dark")
- )
- ),
- dashboardBody(
- tags$head( # must include css
- tags$style(HTML("
- .img-local {
- }
- .small-box .img-local {
- position: absolute;
- top: auto;
- bottom: 5px;
- right: 5px;
- z-index: 0;
- font-size: 70px;
- color: rgba(0, 0, 0, 0.15);
- }"
- ))
- ),
- tabItems(
- tabItem(tabName = "light",
- fluidRow(valueBoxOutput("distLight", width=3)),
- fluidRow(
- box(plotOutput("hist1"), status="primary", width=6),
- box(uiOutput("vBoxesLight"), status="primary", width=6)
- )
- ),
- tabItem(tabName = "dark",
- fluidRow(valueBoxOutput("distDark", width=3)),
- fluidRow(
- box(plotOutput("hist2"), status="primary", width=6),
- box(uiOutput("vBoxesDark"), status="primary", width=6)
- )
- )
- )
- ),
- title="Custom icons"
- )
- server <- function(input, output) {
- source("override.R", local = TRUE) # override 'icon' and 'valueBox'
- clrs <- c("yellow", "orange", "purple", "red", "blue", "navy")
- pTextSize <- function(x, value) tags$p(x, style=paste0("font-size: ", value, "%;"))
- # image files
- fileparts <- c(paste0("normal_", c("mean", "sd", "min", "max", "median"), "_"), "boxplot_iqr_")
- files_white <- paste0("stat_icon_", fileparts, "white.png")
- files_black <- paste0("stat_icon_", fileparts, "black.png")
- # data
- set.seed(1)
- x <- rnorm(1000, 100, 10)
- val <- round(c(mean(x), sd(x), min(x), max(x), median(x)))
- val <- c(val, paste(round(quantile(x, probs = c(0.25, 0.75))), collapse=" - "))
- val <- map2(val, c(rep(100, 5), 75), ~pTextSize(.x, .y))
- text <- map(c("Mean", "Std Dev", "Min", "Max", "Median", "IQR"), ~pTextSize(.x, 150))
- output$vBoxesLight <- renderUI({
- vb <- map(1:6, ~valueBox(
- val[[.x]], text[[.x]],
- icon=icon(list(src=files_white[.x], width="80px"), lib="local"),
- color=clrs[.x], width=NULL)
- )
- fluidRow(
- tags$head(tags$style(HTML(".small-box {height: 100px}"))),
- column(6, vb[[1]], vb[[5]], vb[[3]]),
- column(6, vb[[2]], vb[[6]], vb[[4]])
- )
- })
- output$vBoxesDark <- renderUI({
- vb <- map(1:6, ~valueBox(
- val[[.x]], text[[.x]],
- icon=icon(list(src=files_black[.x], width="80px"), lib="local"),
- color=clrs[.x], width=NULL)
- )
- fluidRow(
- tags$head(tags$style(HTML(".small-box {height: 100px}"))),
- column(6, vb[[1]], vb[[5]], vb[[3]]),
- column(6, vb[[2]], vb[[6]], vb[[4]])
- )
- })
- output$distLight <- renderValueBox({
- x <- "stat_icon_normal_dist_white.png"
- valueBox("Data", "light image icon color",
- icon=icon(list(src=x, width="80px"), lib="local"),
- color="black", width=NULL)
- })
- output$distDark <- renderValueBox({
- x <- "stat_icon_normal_dist_black.png"
- valueBox("Data", "dark image icon color",
- icon=icon(list(src=x, width="80px"), lib="local"),
- color="aqua", width=NULL)
- })
- output$hist1 <- renderPlot({ hist(x) })
- output$hist2 <- renderPlot({ hist(x) })
- }
- # Run the application
- shinyApp(ui = ui, server = server)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement