-1

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:

enter image description here

Oleole
  • 381
  • 4
  • 21
  • 1
    it is possible as long as you have reactive dataset! Sample code will be usefull! – Mal_a Mar 07 '17 at 11:52
  • @Malvina_a I already have a reactive dataset. My question is how can I create something like the picture above by using shiny functions, html, css, etc. – Oleole Mar 07 '17 at 12:22
  • 1
    I have understood the question, but eitherway it is always good to create sample app with sample data, so someone who would like to help you, can easily do it... – Mal_a Mar 07 '17 at 12:26

1 Answers1

1

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)
Mal_a
  • 3,670
  • 1
  • 27
  • 60
  • money<- 0 observeEvent(input$click_counter, { money<- money+500 } output$plt1 <- renderGauge({ gauge(money, min = 0, max = 20000, symbol = '$', label = paste("donation"),gaugeSectors( success = c(15000,20000), warning = c(15000,1000), danger = c(0, 1000))) }) – Oleole Mar 09 '17 at 08:16
  • I am sorry for the bad formatting of my code above, but do you know how to make the number in the gauge to change dynamically every time the input$click_counter is clicked? – Oleole Mar 09 '17 at 08:17
  • I would recommend to use `reactiveValues()` for money – Mal_a Mar 09 '17 at 08:31