闪亮的滑块限制释放鼠标左键的反应

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

因此，在尝试将滑块设置为正确的值（并且不释放鼠标左键！）时，（即我的本地）服务器观察到几个新值并做出相应反应。

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

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

Shiny's sliderInput uses 离子范围滑块 http://ionden.com/a/plugins/ion.rangeSlider/en.html，其中有一个onFinish当用户释放鼠标时的回调。这听起来正是我们所需要的。

这是“惰性”滑块输入的自定义输入绑定，仅在用户释放鼠标时发出值更改的信号（onFinish）或者当滑块被强制更新时（onUpdate).

例如，我只是内联了更改所有 sliderInputs 行为的代码。您需要将其移至外部脚本并进一步自定义。还，onUpdate当滑块初始化时、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)