shiny：光沢のあるアプリにリアクティブバーを追加する方法

Question

寄付金がどれくらい与えられているかを追跡する、群集資金提供の光沢のあるアプリを構築しています。光沢のある反応性バーを作成する機能はありますか？そうでない場合は、これをHTML、CSS、JavaScriptで行うことは可能ですか？

私はこのような何かを作成したいと思います：私は、flexdashboard packageからgaugeを使用するようにあなたをお勧めすることができます

（1）：私はあなたのための2つのソリューションを持っている

Answer 1

をあなたの目的のためにバーではありません。

サンプルアプリケーション：

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)