Анимация от одного номера к другому

Question

Я пытаюсь показать анимацию / переход от 0 к номеру в поле значения. скажем, 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)

В javascript показано решение здесь - http://jsfiddle.net/947Bf/1/ В приведенном ниже сценарии я пытался установить связь с использованием bright.addCustomMessageHandler, но не смог добиться успеха.

tags$script("
 Shiny.addCustomMessageHandler('testmessage',
 function(){
    var o = {value : 0};
    $.Animation( o, {
        value: $('#IRR .inner h3').val()
      }, { 
        duration: 1500,
        easing : 'easeOutCubic'
      }).progress(function(e) {
          $('#IRR .inner h3').text((e.tweens[0].now).toFixed(1));
    });

  });"),

Answer 1

Вот пример. Параметр easing: '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)

---

EDIT

Здесь способ изменить значок в соответствии с value < 10 или value > 10.

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)