shiny: how to add a reactive bar in shiny app

oleole Published at Dev

Oleole

I am building a crowd funding shiny app that tracks how much donation has been given. Is there such a function that creates a reactive bar in shiny? If not, is it possible to do this in html,css,javascript?

I would like to create something like this:

Mal_a

I have two solutions for You:

(1) I can recommend You to use the gauge from flexdashboard package, it is not a bar but for the purpose of Yours can be fine..

Sample App:

library(shiny)
library(shinydashboard)
library(flexdashboard)


ui <- basicPage(flexdashboard::gaugeOutput("plt1"))

server <- shinyServer(function(input, output, session) {

  output$plt1 <- flexdashboard::renderGauge({
    gauge(15399, min = 0, max = 20000, symbol = '$', label = paste("Test Label"),gaugeSectors(
      success = c(15000,20000), warning = c(15000,1000), danger = c(0, 1000)))

  })
})

shinyApp(ui = ui, server = server)

(2) This function helps You to create bar (taken from github)

Sample App:

library(shiny)
library(shinydashboard)

prgoressBar <- function(value = 0, label = FALSE, color = "aqua", size = NULL,
                        striped = FALSE, active = FALSE, vertical = FALSE) {
  stopifnot(is.numeric(value))
  if (value < 0 || value > 100)
    stop("'value' should be in the range from 0 to 100.", call. = FALSE)
  if (!(color %in% shinydashboard:::validColors || color %in% shinydashboard:::validStatuses))
    stop("'color' should be a valid status or color.", call. = FALSE)
  if (!is.null(size))
    size <- match.arg(size, c("sm", "xs", "xxs"))
  text_value <- paste0(value, "%")
  if (vertical)
    style <- htmltools::css(height = text_value, `min-height` = "2em")
  else
    style <- htmltools::css(width = text_value, `min-width` = "2em")
  tags$div(
    class = "progress",
    class = if (!is.null(size)) paste0("progress-", size),
    class = if (vertical) "vertical",
    class = if (active) "active",
    tags$div(
      class = "progress-bar",
      class = paste0("progress-bar-", color),
      class = if (striped) "progress-bar-striped",
      style = style,
      role = "progressbar",
      `aria-valuenow` = value,
      `aria-valuemin` = 0,
      `aria-valuemax` = 100,
      tags$span(class = if (!label) "sr-only", text_value)
    )
  )
}

progressGroup <- function(text, value, min = 0, max = value, color = "aqua") {
  stopifnot(is.character(text))
  stopifnot(is.numeric(value))
  if (value < min || value > max)
    stop(sprintf("'value' should be in the range from %d to %d.", min, max), call. = FALSE)
  tags$div(
    class = "progress-group",
    tags$span(class = "progress-text", text),
    tags$span(class = "progress-number", sprintf("%d / %d", value, max)),
    prgoressBar(round(value / max * 100), color = color, size = "sm")
  )
}

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(disable = TRUE),
  dashboardBody(uiOutput("plt1")))

server <- shinyServer(function(input, output, session) {

output$plt1 <- renderUI({progressGroup(text = "A", value = 15399, min = 0, max = 20000, color = "green")
  })
})

shinyApp(ui = ui, server = server)

Collected from the Internet

Please contact [email protected] to delete if infringement.