Question

我希望能够在动画播放时更新sliderInput动画间隔参数。

这是一个简单的应用程序：

library(shiny)

ui <- fluidPage(
  uiOutput('slider'),
  actionButton('faster', 'faster'),
  actionButton('slower', 'slower'),
  br(),
  htmlOutput('displaySpeed')
)

server <- function(input, output, session) {
  output$slider <- renderUI({
    sliderInput('slider', 'Slider', min = 0, max = 10, value = 1,
                animate = animationOptions(interval = animation$speed))
  })

  # update animation interval 
  animation <- reactiveValues(speed = 100)
  observeEvent(input$faster, {animation$speed <- animation$speed - 20})
  observeEvent(input$slower, {animation$speed <- animation$speed + 20})

  output$displaySpeed <- renderText({
    HTML("Current interval:", animation$speed)
  })
}

shinyApp(ui, server)

如果我通过单击actionButtons启动动画并更改速度，则动画将重置为开头。如果我将隔离（动画$ speed）添加到interval参数，则动画开始后间隔不会改变。

有没有办法让间隔更改而正在播放动画？

Answer 1

对于UI对象（shiny:value）使用Shiny JavaScript事件slider_div，我们可以通过{{1}中的更改提示重新呈现后立即自动重新点击播放按钮来继续动画已完成。

我已将最大值更改为100并启用循环以演示功能。

编辑：添加了一条自定义消息，这样如果重新渲染滑块输入不是更快/更慢按钮的结果，则会忽略它（OP在评论中请求）。

<强> WWW /光泽-events.js

animate$speed

<强> app.R

$(function() {
    var renders = 0;
    var press_play = false;
    $(document).on({

        // COULD ALSO DO $('#slider_div').on('shiny:value', function() {...})
        'shiny:value': function(event) {
            switch (event.name) {
                case 'slider_div':
                    // WONT RESUME IF THE RENDER WAS DUE TO SOMETHING ELSE
                    if (renders > 0 && press_play) {
                        setTimeout(function() {
                            console.log('Animation Speed Changed!');
                            $('.slider-animate-button').click();
                        }, 200);

                        press_play = false;
                    } else {
                      renders = 1;
                    }
                    break;

                default:
            } 
        }

    });


    Shiny.addCustomMessageHandler('resume', function(message) {
        press_play = true;
    });
});

参考：https://shiny.rstudio.com/articles/js-events.html

特别;

请注意，在R中重新计算输出值后会触发library("shiny") ui <- fluidPage( tags$head(singleton(tags$script(src = 'shiny-events.js'))), numericInput("min", "Min", value = 0, min = 0, max = 10), numericInput("max", "Max", value = 100, min = 100, max = 200), sliderInput("speed", "Animation Speed", value = 100, ticks = FALSE, round = 50, min = 50, max = 1000), uiOutput('slider_div'), br(), htmlOutput('displaySpeed') ) server <- function(input, output, session) { output$slider_div <- renderUI({ sliderInput( inputId = 'slider' , label = 'Slider' , min = input$min , max = input$max , value = isolate(animation$value) , animate = animationOptions(interval = animation$speed, loop = TRUE) ) }) # update animation interval animation <- reactiveValues(speed = 100, value = 1) observeEvent(input$speed, { invalidateLater(500, session) animation$value <- input$slider animation$speed <- input$speed }) output$displaySpeed <- renderText({ HTML("Current interval:", animation$speed) }) observeEvent(input$speed, { session$sendCustomMessage('resume', TRUE) }) observeEvent(input$min | input$max, { animation$value <- input$slider }) } shinyApp(ui, server)，但这并不意味着页面上已显示输出值。如果您想在渲染输出值时执行某些操作，请使用shiny:recalculated。

作为要点：

shiny:value

会话：

runGist("https://gist.github.com/McClellandLegge/71472adcfe36270ec876b455beba2bdb")

Answer 2

您可以尝试将value的{{1}}选项更改为sliderInput，以便在重绘滑块时，将当前值作为起始点。

然后在重绘时暂停动画。 isolate(input$slider)可能看起来像（您有两个标识为renderUI的元素，因此我将slider的ID更改为uiOutput）：

slider_holder

sliderInput动态更新动画间隔

2 个答案: