progress bar - Update Shiny-R custom progressbar -
i use put progressbar in shiny apps using shinybs package. new version working bootstrap 3 not have option. shiny included progressbar not customizable wanted, tried remake bs 1 compatible bootstrap 3. works not manage update it.
thanks in advance this!
here exemple, nb : label , size not included in js yet.
server : (from https://gist.github.com/artemklevtsov/d280c4343b052c2aaaef )
server <- function(input, output,session) { tags$script(src="shinyprogress.js"), progressbar <- function(inputid,value = 0, label = false, color = "info", size = null, striped = false, active = false, vertical = 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") htmltools::tags$div( class = "progress", id=inputid, class = if (!is.null(size)) paste0("progress-", size), class = if (vertical) "vertical", class = if (active) "active", htmltools::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, htmltools::tags$span(class = if (!label) "sr-only", text_value) ) ) } updatepb=function(session,inputid,value=null,label=null,color=null,size=null,striped=null,active=null,vertical=null) { data <- dropnulls(list(id=inputid,value=value,label=label,color=color,size=size,striped=striped,active=active,vertical=vertical)) session$sendcustommessage("updateprogress", data) } dropnulls=function(x) { x[!vapply(x,is.null,fun.value=logical(1))] } observe({input$n1 ; updatepb(session,inputid="pb1",value=input$n1)}) }
ui :
ui <- fluidpage( numericinput(inputid="n1", label="numeric input", value=10, min = 0, max = 100, step = 1), mainpanel(progressbar(inputid="pb1",value=10)) )
and add following js code www (as shinyprogress.js) :
shiny.addcustommessagehandler("updateprogress", function(data) { $el = $("#"+data.id); if(data.hasownproperty('value')) { $el.css('width', data.value+'%').attr('aria-valuenow', data.value); }; if(data.hasownproperty('color')) { $el.removeclass("progress-bar-standard progress-bar-info progress-bar-success progress-bar-danger progress-bar-warning"); $el.addclass("progress-bar-"+data.color); }; if(data.hasownproperty('striped')) { $el.toggleclass('progress-bar-striped', data.striped); }; if(data.hasownproperty('active')) { $el.toggleclass('active', data.active); }; if(data.hasownproperty('vertical')) { $el.toggleclass('vertical', data.vertical); }; } );
edit :
i able add clarification, when js code executed, aria-valuenow , width updated in main div modification not taken account :
<div aria-valuenow="100" style="width: 100%;" id="pb1"> <div aria-valuemax="100" aria-valuemin="0" aria-valuenow="0" class="progress-bar progress-bar-info" role="progressbar" style="width:0%;min-width:2em;"> <span class="sr-only">0%</span> </div> </div>
so solution quite easy, change level of id in function :
progressbar <- function(inputid, value=0, label=f, color="info", size=null, striped=f, active=f, vertical=f) { stopifnot(is.numeric(value)) if (value < 0 || value > 100) stop("'value' should in range 0 100", call. = false) if (!(color %in% shinydashboard:::validcolors || color %in% shinydashboard:::validstatuses)) stop("'color' should 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") htmltools::tags$div( class = "progress", # id=inputid, class = if (!is.null(size)) paste0("progress-", size), class = if (vertical) "vertical", class = if (active) "active", htmltools::tags$div( id=inputid, 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, htmltools::tags$span(class = if (!label) "sr-only", text_value) ) ) }
i hope helpfull shiny developper add custom progressbar.
Comments
Post a Comment