update goes into a loop shiny

Question

I have designed a shiny app to change the limits in y of a plot in order to visualize my data (geological time series, y being the depth/time and x any parameter) easily, centred on the y value I want. In the interface I have different input types to navigate in y, such as up and down buttons and a slider. This slider is updating itself if I use the buttons. However, if I click too fast or if I change the slider too fast (i.e. before the plot refreshes), the app will go into a loop and oscillate between two y values.

I've tried using isolate() in different positions but without success, and cannot find how to resolve the bug.

Thank you in advance for your help :-)

Here is an example, click fast on the buttons to make the bug appear;

library(shiny)

ymax <- 100
ymin <- 0


ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    numericInput("heightNumeric", "Height (m)",
                 min = ymin, max = ymax, value = ymin, step = 1),

    sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                value = ymin,step=0.01),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),


    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)


server <- function(input, output, clientData, session) {


  values <- reactiveValues()

  values$i <- 0

  observeEvent(input$up, {
    values$i <- values$i + input$yinter*(input$movepercent/100)
  })

  observeEvent(input$down, {
    values$i <- values$i - input$yinter*(input$movepercent/100)
  })

  observeEvent(input$heightSlider, {
    values$i <- input$heightSlider
  })

  observeEvent(input$heightNumeric, {
    values$i <- input$heightNumeric
  })

  observe({
    updateNumericInput(session,"heightNumeric",value = values$i)
  })

  observe({
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(values$i-input$yinter/2,
                         values$i+input$yinter/2))
  })

}


shinyApp(ui = ui, server = server)

Answer 1

this should work:

library(shiny)

ymax <- 100
ymin <- 0


ui <- fluidPage(
  sidebarPanel(

    h3("See"),

    numericInput("yinter", "Vertical interval (m)",
                 min = 0, max = ymax, value = 50, step = 0.5),

    numericInput("movepercent", "Scroll interval (%)",
                 min = 0, max = 100, value = 15, step = 5),

    uiOutput("inputs"),

    actionButton("up","",icon("arrow-up"),
                 width = "100%"),

    actionButton("down","",icon("arrow-down"),
                 width = "100%",""),


    width=2
  ),

  sidebarPanel(
    plotOutput("plot1",height = 800)
  )

)


server <- function(input, output, clientData, session) {


  ival <- reactiveVal(0)

  observeEvent(input$up, {
    newval <- ival() + input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$down, {
    newval <- ival() - input$yinter*(input$movepercent/100)
    ival(newval)
  })

  observeEvent(input$heightSlider, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightSlider)
  }
  })

  observeEvent(input$heightNumeric, {
  if(input$heightNumeric != input$heightSlider){
    ival(input$heightNumeric)
  }
  })

  output$inputs <- renderUI({
    newval <- ival()
    tagList(
      numericInput("heightNumeric", "Height (m)",
                   min = ymin, max = ymax, value = newval, step = 1),

      sliderInput("heightSlider","Height (m)",min = ymin, max = ymax, 
                  value = newval ,step=0.01)

    )
  })

  output$plot1 <- renderPlot({
    plot(seq(from=0,to=1,by=0.0001),seq(from=0,to=100,by=0.01),
         type="l",ylim=c(ival() - input$yinter/2,
                         ival() + input$yinter/2))
  })
}

shinyApp(ui = ui, server = server)