Javascript R闪亮仪表板值框：从一个数字到另一个数字的动画_Javascript_Jquery_R_Shiny

Javascript R闪亮仪表板值框：从一个数字到另一个数字的动画

javascript jquery r shiny

Javascript R闪亮仪表板值框：从一个数字到另一个数字的动画,javascript,jquery,r,shiny,Javascript,Jquery,R,Shiny,我正在尝试在valuebox中显示从0到数字的动画/转换。假设valuebox中为92.6。例如，如果需要显示值90.6，它将从0转换为90.6 示例 library(shinydashboard) library(dplyr) # UI ui <- dashboardPage(skin = "black", dashboardHeader(title = "Test"), dashboardSidebar(d

我正在尝试在valuebox中显示从0到数字的动画/转换。假设valuebox中为92.6。例如，如果需要显示值90.6，它将从0转换为90.6

示例

library(shinydashboard)
library(dplyr)
# UI
ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "Test"),
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                        fluidRow(
                            valueBoxOutput("test_box")
                        )
                    )
)

# Server response
server <- function(input, output, session) {
    output$test_box <- renderValueBox({
        iris %>% 
            summarise(Petal.Length = mean(Petal.Length)) %>% 
            .$Petal.Length %>% 
            scales::dollar() %>% 
            valueBox(subtitle = "Unit Sales",
                     icon = icon("server"),
                     color = "purple"
        )
    })
}

shinyApp(ui, server)

这里有一个例子。参数“easeOutCubic”会导致一些错误，所以我删除了这一行

library(shiny)
library(shinydashboard)

js <- "
Shiny.addCustomMessageHandler('anim',
 function(x){
    
    var $s = $('div.small-box div.inner h3'); 
    var o = {value: 0};
    $.Animation( o, {
        value: x
      }, { 
        duration: 1500
        //easing: 'easeOutCubic'
      }).progress(function(e) {
          $s.text('$' + (e.tweens[0].now).toFixed(1));
    });

  }
);"

# UI
ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "Test"),
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      tags$head(tags$script(js)),
                      fluidRow(
                        valueBox("", subtitle = "Unit Sales",
                                 icon = icon("server"),
                                 color = "purple"
                        )
                      ),
                      br(),
                      actionButton("btn", "Change value")
                    )
)

# Server response
server <- function(input, output, session) {
  
  rv <- reactiveVal(10)
  
  observeEvent(input[["btn"]], {
    rv(rpois(1,20))
  })
  
  observeEvent(rv(), {
    session$sendCustomMessage("anim", rv())
  })
  
}

shinyApp(ui, server)

编辑下面是一种将id设置为长方体的动画长方体的方法。这允许使用相同的JS代码制作多个动画框：

library(shiny)
library(shinydashboard)

js <- "
Shiny.addCustomMessageHandler('anim',
 function(x){

    var $box = $('#' + x.id + ' div.small-box');
    var value = x.value;

    var $icon = $box.find('i.fa');
    if(value <= 10 && $icon.hasClass('fa-arrow-up')){
      $icon.removeClass('fa-arrow-up').addClass('fa-arrow-down');
    }
    if(value > 10 && $icon.hasClass('fa-arrow-down')){
      $icon.removeClass('fa-arrow-down').addClass('fa-arrow-up');
    }

    var $s = $box.find('div.inner h3');
    var o = {value: 0};
    $.Animation( o, {
        value: value
      }, {
        duration: 1500
      }).progress(function(e) {
          $s.text('$' + (e.tweens[0].now).toFixed(1));
    });

  }
);"

# UI
ui <- dashboardPage(
  skin = "black",
  dashboardHeader(title = "Test"),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tags$head(tags$script(HTML(js))),
    fluidRow(
      tagAppendAttributes(
        valueBox("", subtitle = "Unit Sales",
                 icon = icon("server"),
                 color = "purple"
        ),
        id = "mybox"
      )
    ),
    br(),
    actionButton("btn", "Change value")
  )
)

# Server response
server <- function(input, output, session) {

  rv <- reactiveVal(10)

  observeEvent(input[["btn"]], {
    rv(rpois(1,20))
  })

  observeEvent(rv(), {
    session$sendCustomMessage("anim", list(id = "mybox", value = rv()))
  })

}

shinyApp(ui, server)

库（闪亮）
图书馆（shinydashboard）
非常感谢你。如果我使用renderValueBox（）将valuebox移动到服务器并在UI中添加valueBoxOutput，则它不起作用。我这样做的原因是因为我想根据值更改图标。例如，图标=如果(value@UjjawalBhandari我们可以在addCustomMessageHandler
中的Javascript中实现这一点。请参阅我的编辑。非常感谢您的努力。非常感谢。最后一个请求（如果您不介意的话）-如果我有多个框，即使我有两个不同数字的reactiveVal，它也会显示相同的值。我猜这是因为div.small-box。您能不能慷慨地将此函数变得更通用，以便我们可以将其用于任何数量的值框？@UjjawalBhandari将值框
包装在一个div
中，并带有一个id:div（id=“myid”，valueBox（…）
。然后将所有选择器$（'div.small-box…'）
替换为$（'myid div.small-box…'））
@Stéphanelant谢谢你的回答+1。有没有办法把盒子的id作为一个额外参数传递给anim？否则，我看不出这如何适用于多个盒子。为每个盒子创建一个脚本，将盒子的id硬编码到脚本中会非常耗时且不雅观。
library(shiny)
library(shinydashboard)

js <- "
Shiny.addCustomMessageHandler('anim',
 function(x){
    
    var $icon = $('div.small-box i.fa');
    if(x <= 10 && $icon.hasClass('fa-arrow-up')){
      $icon.removeClass('fa-arrow-up').addClass('fa-arrow-down');
    }
    if(x > 10 && $icon.hasClass('fa-arrow-down')){
      $icon.removeClass('fa-arrow-down').addClass('fa-arrow-up');
    }
    
    var $s = $('div.small-box div.inner h3'); 
    var o = {value: 0};
    $.Animation( o, {
        value: x
      }, { 
        duration: 1500
        //easing: 'easeOutCubic'
      }).progress(function(e) {
          $s.text('$' + (e.tweens[0].now).toFixed(1));
    });

  }
);"

# UI
ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "Test"),
                    dashboardSidebar(disable = TRUE),
                    dashboardBody(
                      tags$head(tags$script(HTML(js))),
                      fluidRow(
                        valueBox("", subtitle = "Unit Sales",
                                 icon = icon("arrow-up"),
                                 color = "purple"
                        )
                      ),
                      br(),
                      actionButton("btn", "Change value")
                    )
)

# Server response
server <- function(input, output, session) {
  
  rv <- reactiveVal(10)
  
  observeEvent(input[["btn"]], {
    rv(rpois(1,10))
  })
  
  observeEvent(rv(), {
    session$sendCustomMessage("anim", rv())
  })
  
}

shinyApp(ui, server)

library(shiny)
library(shinydashboard)

js <- "
Shiny.addCustomMessageHandler('anim',
 function(x){

    var $box = $('#' + x.id + ' div.small-box');
    var value = x.value;

    var $icon = $box.find('i.fa');
    if(value <= 10 && $icon.hasClass('fa-arrow-up')){
      $icon.removeClass('fa-arrow-up').addClass('fa-arrow-down');
    }
    if(value > 10 && $icon.hasClass('fa-arrow-down')){
      $icon.removeClass('fa-arrow-down').addClass('fa-arrow-up');
    }

    var $s = $box.find('div.inner h3');
    var o = {value: 0};
    $.Animation( o, {
        value: value
      }, {
        duration: 1500
      }).progress(function(e) {
          $s.text('$' + (e.tweens[0].now).toFixed(1));
    });

  }
);"

# UI
ui <- dashboardPage(
  skin = "black",
  dashboardHeader(title = "Test"),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tags$head(tags$script(HTML(js))),
    fluidRow(
      tagAppendAttributes(
        valueBox("", subtitle = "Unit Sales",
                 icon = icon("server"),
                 color = "purple"
        ),
        id = "mybox"
      )
    ),
    br(),
    actionButton("btn", "Change value")
  )
)

# Server response
server <- function(input, output, session) {

  rv <- reactiveVal(10)

  observeEvent(input[["btn"]], {
    rv(rpois(1,20))
  })

  observeEvent(rv(), {
    session$sendCustomMessage("anim", list(id = "mybox", value = rv()))
  })

}

shinyApp(ui, server)