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

Posted 2023-03-24

【中文标题】如何实时刷新 Shiny 中的 sliderInput()（不仅在滑动结束时）？

【英文标题】：How to refresh sliderInput() in Shiny in real time (not only when the sliding ends)?

【发布时间】：2021-11-01 02:46:03

【问题描述】：

不好意思，不知道题主说的够清楚吗：在Shiny中，每次滑块滑动时，只会在滑动结束时计算更新值。如果我将它的值链接到图表，滑动时看起来不是很平滑（图表只会在鼠标松开或几秒钟后改变，而不是随着滑动而变化）。

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

Input and Chart

我的部分代码如下：

在ui.R中：

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

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)
  )

Shiny 的例子：

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

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

【问题讨论】：

不知道有没有办法，还是闪亮的服务器限制了。我尝试给滑条加动画（模拟平滑滑动），但是虽然滑条中的动画很流畅，但是剧情还是会有延迟（如果动画速度太快，可能会拖到最后动画的，情节中的点仍在移动）

我想要达到的效果类似于在电脑上调节音量。滑动音量条时是连续变化的，而不是松开鼠标后音量变化。

我认为这是不可能的。闪亮的反应式并不是为了快速而设计的。你想要的是前端 -> 后端 -> 前端。更深一层看，就是用户交互->javascript->json数据->websocket->R json to list->R输入变化->R渲染函数->json->websocket->js。您会看到涉及多少进程，并且 js 和 R 都不是为它的速度而设计的。如果您处理来自服务器的数据，您总会有一些延迟。我的建议是纯粹在前端使用 javascript 并使用 plotly js API 来更新图表。这样你就只有 js -> plotly API。

好的，谢谢你的想法。昨天我也在考虑js，我去试试

【参考方案1】：

在阅读了一些source code of sliderInput 之后，我发现只有在HTML 代码中没有data-immediate 属性的情况下，才会遵守滑块的默认debounce 行为（参见the getRatePolicy section of this article）。

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

注意。如果您查看之前引用的源代码，您会看到receiveMessage 会将immediate 重置为false。每当我们使用updateSliderInput 时，都会调用receiveMessage。因此，在调用 updateSliderInput 之后，我们必须重新分配 immediate 数据属性才能看到行为。

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

但是，请注意，闪亮的团队没有向最终用户公开此功能很可能是有原因的，因此应将此解决方案视为 hack 并谨慎使用。 （从源代码来看，他们在使用updateSliderInput（因此receiveMessage）时使用immediate属性来否决默认速率策略。

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);")
      )
   )