滑块输入延迟

Question

有没有办法让 sliderInput 在更改其对应的 input$ 变量之前等待几秒钟？我有一个控制图表的栏，该图表需要在值更改时重新呈现。我知道使用提交按钮的解决方法，我希望避免需要它。

Answer 1

您可以使用 invalidateLater。可以用一种幼稚但简洁的方式来完成：

library(shiny)
shinyApp(
  server = function(input, output, session) {
      values <- reactiveValues(mean=0)

      observe({
        invalidateLater(3000, session)
        isolate(values$mean <- input$mean)
      })

      output$plot <- renderPlot({
          x <- rnorm(n=1000, mean=values$mean, sd=1)
          plot(density(x))
      })
  },
  ui = fluidPage(
    sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
    plotOutput("plot")
  )
)

此方法的问题在于，当更改滑块输入并触发 invalidate 事件时，您仍然可以触发执行。如果那是问题所在，您可以尝试更复杂的方法，检查值是否已更改以及已看到多少时间值。

library(shiny)
library(logging)
basicConfig()

shinyApp(
  server = function(input, output, session) {
      n <- 2 # How many times you have to see the value to change
      interval <- 3000 # Set interval, make it large so we can see what is going on

      # We need reactive only for current but it is easier to keep
      # all values in one place
      values <- reactiveValues(current=0, pending=0, times=0)

      observe({
        # Invalidate 
        invalidateLater(interval, session)

        # Isolate so we don't trigger execution
        # by changing reactive values
        isolate({
            m <- input$mean

            # Slider value is pending and not current
            if(m == values$pending && values$current != values$pending) {
                # Increment counter
                values$times <- values$times + 1
                loginfo(paste(values$pending, "has been seen", values$times, "times"))

                # We've seen value enough number of times to plot
                if(values$times == n) {
                    loginfo(paste(values$pending, "has been seen", n, "times. Replacing current"))
                    values$current <- values$pending
                }

            } else if(m != values$pending) { # We got new pending
                values$pending <- m
                values$times <- 0
                loginfo(paste("New pending", values$pending))
            }
        })
      })

      output$plot <- renderPlot({
          x <- rnorm(n=1000, mean=values$current, sd=1)
          plot(density(x))
      })
  },
  ui = fluidPage(
    sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
    plotOutput("plot")
  )
)

Answer 2

debounce就是为此而生的，而且更简单。修改前一个回答者的代码：

library(shiny)
library(magrittr)
shinyApp(
  server = function(input, output, session) {
      d_mean <- reactive({
        input$mean
      }) %>% debounce(1000)
      output$plot <- renderPlot({
          x <- rnorm(n=1000, mean=d_mean(), sd=1)
          plot(density(x))
      })
  },
  ui = fluidPage(
    sliderInput("mean", "Mean:", min = -5, max = 5, value = 0, step= 0.1),
    plotOutput("plot")
  )
)

滑块输入延迟

Delay on sliderinput

r

shiny

delay

invalidation