更新进入循环闪亮答案

【问题标题】：update goes into a loop shiny更新进入循环闪亮
【发布时间】：2017-07-10 08:58:08
【问题描述】：

我设计了一个闪亮的应用程序来更改绘图的 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)

【问题讨论】：

我似乎无法在我的电脑上复制您的问题。需要注意的一点是，这些按钮允许您选择滑块范围之外的值。
@JarkoDubbeldam 我真的可以。只需尝试尽可能快地单击按钮，然后它就会开始振荡。
@SébastienWouters 这只是我在向按钮发送垃圾邮件时注意到的。

标签： r shiny rstudio

【解决方案1】：

这应该可行：

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)

【讨论】：

为什么这是公认的答案？是什么让这项工作和其他工作不奏效？

【解决方案2】：

您可以尝试隔离您的高度滑块和高度数字，并使其响应对操作按钮的点击：

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)

【讨论】：

这确实解决了振荡问题，但是它可以在使用数字输入时更新滑块，反之亦然在使用滑块时更新数字输入

【解决方案3】：

您不需要隔离任何东西，但您必须删除应用程序中的循环依赖项。现在，您确实可能会陷入振荡，因为所有更新都是独立发生的。因此，如果两个输入在所有内容更新之前更改values$i，您将看到这些值之间的持续波动，正如您所看到的那样。

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

这为您提供了以下服务器功能。你可以尝试你想要的，因为更新都是在一个表达式中完成的，所有的东西都会在闪亮评估链中的下一个反应之前更新。

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

}

【讨论】：

此解决方案部分有效：振荡问题仍然存在，但如果我抑制滑块或数字输入的 observeEvent 中的更新之一，它可以工作。然而，在这种情况下，只有这两个中的一个会更新。
@SébastienWouters 很奇怪，我不能让它再振荡，它不应该。我再看看能不能避免这种情况。
根据 OP 请求取消删除

【解决方案4】：

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

现在假设您更新了滑块。 observeEvent 更新 ival()。这会触发observer() 更新两个输入。但是，如果您在将这些更新发送到客户端之前按下例如up 按钮，ival 在发送旧值以更新输入之前更改为新值。旧值会更改input$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)

【讨论】：

我试过了，遗憾的是它似乎不起作用：它仍然在振荡
@SébastienWouters 确实如此，而且我现在已经错了几次 :-)。原来问题是更新消息总是在所有其他观察者运行之后发送。因此，您必须停止使用更新功能并呈现我在更新答案中显示的 UI。
好的，没问题 :-) 我重试了这段代码，即使它出现振荡，一段时间后它也会稳定下来。您可以重新上传您拥有的第一个解决方案吗？我有它但忘记保存它；有了它，滑块和按钮单独工作得很好。谢谢你的一切:-)
@SébastienWouters 这很正常，闪亮必须经过几个循环才能将所有内容更新为新值。我个人也会放弃至少一项输入。同一件事的三个输入似乎有点矫枉过正:-)