R 更新进入一个循环

我已经设计了一个闪亮的应用程序来更改绘图的y限制，以便以我想要的y值为中心，轻松地可视化我的数据（地质时间序列，y是深度/时间，x是任何参数）。在界面中，我有不同的输入类型可以在y中导航，例如上下按钮和滑块。如果我使用按钮，此滑块将自动更新。但是，如果我单击太快或更改滑块太快（即在绘图刷新之前），应用程序将进入循环并在两个y值之间振荡

我尝试在不同的位置使用isolate（），但没有成功，并且找不到如何解决该错误

提前感谢您的帮助：-）

下面是一个例子，快速点击按钮使bug出现

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)

库（闪亮）
ymax您可以尝试隔离hight滑块和height numeric，并使其响应对操作按钮的单击：

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(i = 0)

  values$i <- 0

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

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

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

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

  observe({
    if (input$up==0 & input$down==0) return()
    isolate({
      updateNumericInput(session,"heightNumeric",value = values$i)      
    })
  })

  observe({
    if (input$up==0 & input$down==0) return()
    isolate({
      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)

库（闪亮）
ymax您不需要隔离任何东西，但必须删除应用程序中的循环依赖项。现在，由于所有的更新都是独立进行的，因此您确实可以以振荡结束。因此，如果在更新所有内容之前，两个输入值都发生了变化，
值$i
，您将在这些值之间得到一个连续的振荡，如您所见

最简单的解决方案是只更新每个观察者内部需要更新的内容。因此，当触摸滑块时，立即更新
数值输入
。触摸数字输入时，立即更新
滑块输入
。按下任一按钮时，更新两个按钮

这将为您提供以下服务器功能。您可以尝试您想要的，因为所有更新都在一个表达式中完成，所以在链中的下一个反应之前，所有内容都会更新

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


  values <- reactiveValues()

  values$i <- 0

  observeEvent(input$up, {
    values$i <- values$i + input$yinter*(input$movepercent/100)
    updateNumericInput(session,"heightNumeric",value = values$i)
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  observeEvent(input$down, {
    values$i <- values$i - input$yinter*(input$movepercent/100)
    updateNumericInput(session,"heightNumeric",value = values$i)
    updateSliderInput(session,"heightSlider",value = values$i)
  })

  observeEvent(input$heightSlider, {
    values$i <- input$heightSlider
    updateNumericInput(session,"heightNumeric",value = values$i)
  })

  observeEvent(input$heightNumeric, {
    values$i <- input$heightNumeric
    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))
  })

}

server我完全错了。问题确实是数字和滑块输入的异步更新。更确切地说，更新函数（
updateSliderInput
resp
updateNumericInput
）不会立即更新滑块。只有在运行所有其他观察程序后，这些更新才会发送到客户端

现在，假设您更新了滑块。
observeEvent
更新
ival（）。这将触发
observer（）
更新两个输入。但是，如果在将这些更新发送到客户端之前按下
up
按钮，
ival
将在发送旧值以更新输入之前更改为新值。该旧值会更改
输入$sliderInput
，这会再次触发
observeEvent（）
，并开始新的循环。我相信这就是导致你振荡的原因

要解决这个问题，您需要在服务器端重新生成输入，而不是在客户端更新输入。或者你可以避免在同一件事情上使用4种不同的输入

因此，您的示例应用程序变成：

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, {
    ival(input$heightSlider)
  })

  observeEvent(input$heightNumeric, {
    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)

库（闪亮）
ymax这应该有效：

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)

库（闪亮）
ymax我似乎无法在我的电脑上复制您的问题。需要注意的是，按钮允许您选择滑块范围之外的值。@JarkoDubbeldam我实际上可以。只要试着尽可能快地点击按钮，它就会在某一点开始振荡。@SébastienWouters这正是我在滥发按钮时注意到的。这个解决方案部分有效：振荡问题仍然存在，但如果我抑制滑块或数字输入的观察事件中的一个更新，它就会工作。然而，在这种情况下，这两个函数中只有一个会更新。@SébastienWouters奇怪，我不能让它再振荡了，它也不应该再振荡了。我会再看一看，看我是否可以避免这种情况。按操作请求取消删除此操作确实解决了振荡问题，但它在使用数字输入时启用滑块更新，反之亦然。使用滑块时启用数字输入更新我尝试过，遗憾的是，它似乎不起作用：它仍然有效oscillates@S巴斯蒂安沃斯的确，我已经错了好几次了：-）。问题是，更新消息总是在所有其他观察程序运行后发送。因此，您必须停止使用更新函数，并按照我在更新的答案中显示的方式呈现UI。好的，没问题：-）我重试了此代码，即使它发生振荡，也会在一段时间后稳定下来。你能重新提出你的第一个解决方案吗？我有它，但忘了保存它；有了它，滑块和按钮单独工作得很好。感谢您所做的一切：-）@SébastienWouters这很正常，在所有内容更新为新值之前，shiny必须经过几个循环。我个人也会放弃至少一个输入。同一事物的三个输入似乎有点过分：-）为什么这是公认的答案？是什么使这项工作而其他工作不起作用？