r - Shiny 的 slider 限制释放鼠标左键的 react

Question

我正在使用 Shiny 应用程序，其中可能需要一些时间才能将 slider 设置为正确的值。

因此，在尝试将 slider 设置为正确的值(并且不释放鼠标左键!)时，(即我的本地)服务器观察到几个新值并做出相应的 react 。

由于我的服务器对任何新值的响应可能需要几秒钟，如果我可以:

• 推迟向服务器发送信号，直到释放鼠标左键，或者
• 在服务器端，如果收到新值，则中止任何先前的响应

Answer 1

Shiny 的 sliderInput 使用 Ion.RangeSlider ，当用户释放鼠标时，它有一个 onFinish 回调。这听起来正是我们所需要的。

这是一个“惰性” slider 输入的自定义输入绑定(bind)，仅在用户释放鼠标 (onFinish) 或强制更新 slider (onUpdate)。

例如，我只是内联了更改所有 sliderInputs 行为的代码。您需要将其移至外部脚本并进一步自定义。此外，onUpdate 在 slider 初始化时、Shiny 初始化输入值之前被调用。您必须等到 Shiny 执行此操作才能在 onUpdate 中调用值更改回调。我使用的解决方案并不出色，但我太懒了，找不到更干净的方法。

library(shiny)

ui <- fluidPage(
  tags$head(
    tags$script(HTML("
      (function() {
        var sliderInputBinding = Shiny.inputBindings.bindingNames['shiny.sliderInput'].binding;

        var lazySliderInputBinding = $.extend({}, sliderInputBinding, {
          subscribe: function(el, callback) {
            var $el = $(el);
            var slider = $el.data('ionRangeSlider');

            var handleChange = function() {
              if (!inputsInitialized) return;
              callback(!$el.data('immediate') && !$el.data('animating'));
            };

            slider.update({
              onUpdate: handleChange,
              onFinish: handleChange
            });
          },

          unsubscribe: function(el, callback) {
            var slider = $(el).data('ionRangeSlider');
            slider.update({
              onUpdate: null,
              onFinish: null
            });
          }
        });

        Shiny.inputBindings.register(lazySliderInputBinding, 'shiny.lazySliderInput');

        var inputsInitialized = false;
        $(document).one('shiny:connected', function() {
          inputsInitialized = true;
        });
      })();
    "))
  ),
  sliderInput("sliderA", "A", 0, 10, 5),
  uiOutput("sliderB"),
  verbatimTextOutput("sliderValues"),
  actionButton("resetSliders", "Reset Sliders")
)

server <- function(input, output, session) {
  observeEvent(input$resetSliders, {
    updateSliderInput(session, "sliderA", value = 5)
    updateSliderInput(session, "sliderB", value = c(4, 6))
  })

  output$sliderB <- renderUI({
    sliderInput("sliderB", "B", 0, 10, c(4, 6))
  })

  output$sliderValues <- renderPrint({
    cat(paste("Slider A =", input$sliderA), "\n")
    cat(paste("Slider B =", paste(input$sliderB, collapse = " ")))
  })
}

shinyApp(ui, server)