Question

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

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

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

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

Answer 1

好吧，经过一番挖掘，我想我已经找到了解决方案。看起来最干净的方法就是使用shinyCustom包，它具有useShinyCustom和customSliderInput功能，而不需要乱用Java脚本。通过这些，您可以将反应性设置为＆＃34;去抖动＆＃34;并且还拖延了延迟时间。如果您要同时使用这些选项，您应该能够找到最佳位置，仅在滑块停止移动时更新输出。它在发布鼠标按钮时不会是一个完美的＆＃34;＆＃34;但它应该非常接近！

例如，您可以尝试以下方式：

# Slider delay type is actually "debounce" by default 
useShinyCustom(slider_delay = "500"), # Doubles the default delay time in ms
customSliderInput("bins", #Use customSliderInput instead of sliderInput
              "Number of bins:",
              min = 1,
              max = 50,
              value = 30)

Answer 2

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

这是“懒惰”滑块输入的自定义输入绑定，仅在用户释放鼠标（onFinish）或强制更新滑块（onUpdate）时发出值更改信号。 / p>

对于该示例，我只是内联了更改ALL 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)

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

2 个答案: