闪亮的：如何在闪亮的应用程序中添加反应栏

Question

我正在构建一个众筹闪亮的应用程序，用于跟踪捐赠了多少。是否有这样的功能可以在闪亮的状态下创建反应条？如果没有，是否可以在 html,css,javascript 中执行此操作？

我想创建这样的东西：

Answer 1

我有两个解决方案给你：

(1) 我可以推荐你使用flexdashboard package 中的gauge，它不是酒吧，但对于你的目的来说可以。..

示例应用：

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)此功能帮助您创建条形图（取自github）

示例应用：

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)