时间戳

首页 > 解决方案 > R 闪亮 - 动画随机数到 ValueBox

r - R 闪亮 - 动画随机数到 ValueBox

问题描述

我想在 R 中制作一个闪亮的小动画。

核心是将 a sample(1:100, 1), 在 a 中valueBox，但我想通过打印随机数几秒钟来制作动画，最后打印sample结果。

我找到了以下使用 JavaScript 的代码。问题是代码生成了一个从0到生成的随机数的动画sample。

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');

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

  }
);"

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

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

  rv <- reactiveVal()

  observeEvent(input[["btn"]], {
    rv(sample(1:100, 1))
  })

  observeEvent(rv(), {
    for(i in 1:30){
      session$sendCustomMessage("anim", list(id = "mybox", value = rv()))
    }
  })

}

shinyApp(ui, server)

我还发现这段代码在 JS 中完全符合我的要求，但我不能把它放在闪亮的地方。

标签： rshiny

解决方案

没有必要求助于 Javascript。Shiny 有一个内置的计时器。

这个 MWE 创建一个值框，显示一个在 1 到 100 范围内随机选择的整数，每秒更新一次。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    valueBoxOutput("random")
  )
)

server <- function(input, output, session) {
  output$random <- renderValueBox({
    invalidateLater(1000, session)
    valueBox("Value", sample(1:100, 1))
  })
}

shinyApp(ui = ui, server = server)

推荐阅读