如何在Shiny中实时刷新sliderInput()（不仅仅是滑动结束时）？

抱歉，不知道问题说得够清楚吗：在Shiny中，滑块每次滑动时，只会计算并更新滑动结束时的值。如果我将它的值链接到图表上，滑动时看起来不太平滑（图表只会在释放鼠标时或几秒钟后发生变化，而不是随着滑动而不断变化）。

使用滑动条改变y，图表中红点的位置就会改变。

输入和图表 https://i.stack.imgur.com/7M3wD.png

我的部分代码如下：

In ui.R:

sliderInput("slider_mean", 
HTML("Try to change the value of ŷ:"),
min = 1, max = 200, value = 100,width="30%"),

plotlyOutput('meanplot'),

在server.R中：（这段代码可能不完整，只是举个例子）

  output$meanplot <- renderPlotly({
    
    meantb <- data.frame(y_hat = 1:200) %>%
      mutate(col2 =(y_mean1()-y_hat)^2+(y_mean2()-y_hat)^2+(y_mean3()-y_hat)^2+(y_mean4()-y_hat)^2+(y_mean5()-y_hat)^2+(y_mean6()-y_hat)^2)

    #Here is to input the slider value
    highlight_adjust <- meantb %>% 
      filter(y_hat %in% input$slider_mean)
    
    p=ggplot(meantb,
           aes(x = y_hat, y = col2)) + 
      
      geom_point(size =0.7,color="black") +
      
      geom_point(data=highlight_adjust, 
                 aes(x = y_hat, y = col2), 
                 color='red')+

      geom_line(size = 0.2,color="black") +
    ggplotly(p)
  })

闪亮的例子：

https://shiny.rstudio.com/gallery/slider-bar-and-slider-range.html https://shiny.rstudio.com/gallery/slider-bar-and-slider-range.html

如果我们快速移动滑块，输出值就会有延迟。

阅读了一些内容后的源代码sliderInput https://github.com/rstudio/shiny/blob/2ce18ef3248bdeebdfadf7846fa61bfbf1b064a0/inst/www/shared/shiny.js#L6159我发现默认的debounce行为（参见the getRatePolicy本文的部分 https://shiny.rstudio.com/articles/building-inputs.html）的滑块仅在没有a的情况下才被粘附data-immediateHTML 代码中的属性。

也就是说，我们只需将此属性添加到 HTML 中，滑块就会立即做出反应。

Note.如果你查看之前引用的源代码，你会发现receiveMessage将重置immediate to false. receiveMessage每当我们使用时都会被调用updateSliderInput。因此，调用后updateSliderInput我们必须重新分配immediatedata 属性以便仍然看到行为。

在下面的示例中，您会看到被修改的滑块的值会立即更新，而第二个滑块则显示默认行为。点击一下update会将这种行为转变为某种附带损害，如果您想使用updateSliderInput，您应该确保data-immediate再次添加属性（代码为reset按钮显示了一种可能的方法）。

但是，请注意，闪亮的团队很可能有一个原因没有向最终用户公开此功能，因此该解决方案应被视为黑客并谨慎使用。 （从源代码来看，他们使用了immediate使用时属性推翻默认速率策略updateSliderInput（因此receiveMessage).

library(shiny)
library(shinyjs)

my_sld <- function(...) {
   sld <- sliderInput(...)
   sld$children[[2]]$attribs$`data-immediate` <- "true"
   sld
}

shinyApp(
   fluidPage(
      useShinyjs(),
      my_sld("sld1", "Immediate:", 1, 10, 1), 
      verbatimTextOutput("dbg1"),
      sliderInput("sld2", "Debounced:", 1, 10, 1),
      verbatimTextOutput("dbg2"),
      actionButton("update", "Update kills Immediateness"),
      actionButton("reset", "Re-add immediate attribute")
      ),
   function(input, output, session) {
      output$dbg1 <- renderPrint(input$sld1)
      output$dbg2 <- renderPrint(input$sld2)
      observeEvent(input$update, {
         updateSliderInput(session, "sld1", value = 8)
      })
      observeEvent(input$reset, {
         runjs("$('#sld1').data('immediate', true);")
      })
   })