Bi-directional synchronization without triggering a loop

I am currently still investigating the problem, but what I am currently experiencing is that an infinite update loop is generated due to the fact that I am trying to do bi-directional sync between a model reactiveValues and a input text. This only occurs when there's a delay (e.g. of a second, induced by adding a Sys.sleep(1) into another handler that pauses the evaluation).

  observeEvent({input$nameText},                                                          
  {                                                                                       
    print("name text changed")                                                            
    print(input$nameText)                                                                 
    app_model$name <- input$nameText                                                      
  })                                                                                      
                                                                                          
  observeEvent({app_model$name},                                                          
  {                                                                                       
    print("app model changed")                                                            
    print(app_model$name)                                                                 
    updateTextInput(session, "nameText", value = app_model$name)                          
  }) 

The problem seems to occur due to other events. This triggers traffic structured as such

{"method":"update","data":{"mainTab-sendReportUi-nameText":"Stefanos"}}
{"progress":{"type":"binding","message":{"id":"mainTab-sendReportUi-checklistUi"}}}
{"progress":{"type":"binding","message":{"id":"mainTab-sendReportUi-sendReportButtonUi"}}}
{"recalculating":{"name":"mainTab-sendReportUi-checklistUi","status":"recalculating"}}
{"recalculating":{"name":"mainTab-sendReportUi-checklistUi","status":"recalculated"}}
{"recalculating":{"name":"mainTab-sendReportUi-sendReportButtonUi","status":"recalculating"}}
{"recalculating":{"name":"mainTab-sendReportUi-sendReportButtonUi","status":"recalculated"}}
{"busy":"idle"}|15|14:16:16.295|
{"errors":{},"values":{"mainTab-sendReportUi-sendReportButtonUi":{"html":"<button id=\"mainTab-sendReportUi-sendReportButton\" type=\"button\" class=\"btn btn-default action-button\">\n <i class=\"fa fa-file\"><\/i>\n Send Report\n<\/button>","deps":[{"name":"font-awesome","version":"5.3.1","src":{"href":"font-awesome-5.3.1"},"meta":null,"script":null,"stylesheet":["css/all.min.css","css/v4-shims.min.css"],"head":null,"attachment":null,"all_files":true}]},"mainTab-sendReportUi-checklistUi":null},"inputMessages":[{"id":"mainTab-sendReportUi-nameText","message":{"value":"Stefanossssssssssssss"}}]}
{"busy":"busy"}
{"method":"update","data":{"mainTab-sendReportUi-nameText":"Stefanossssssssssssss"}}

and the cycle restarts.

What seems to be happening is that, due to the delay, the message about the bidirectional sync never gets extinguished due to equality on the client side.

I understand my question is vague, but I'd like to know how this kind of issue is generally handled.

Please note that renderUi has the nasty behavior of throwing away the subtree and replacing it with a new control, which means that the browser (especially IE) thinks that the page has been changed and, for example, concludes it's shorter. the result is that the scrollbar goes back to top.

are you doing something conceptually like this ?

where bins1 drives histogram but also updates slider bins2.
slider bins2 updates slider1 (and therefore implicitly the histogram)

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),
    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
          sliderInput("bins1",
            "Number of bins:",
            min = 1,
            max = 50,
            value = 30
          ),
          sliderInput("bins2",
            "Number of bins:",
            min = 1,
            max = 50,
            value = 30
          )
        ), mainPanel(
           plotOutput("distPlot")
        )
    ))


# Define server logic required to draw a histogram
server <- function(input, output,session) {

    observeEvent(input$bins1,{
        print("update 2")
        updateSliderInput(session=session,
                          inputId = "bins2",
                          value = input$bins1)
    })
    observeEvent(input$bins2,{
        print("update 1")
        updateSliderInput(session=session,
                          inputId = "bins1",
                          value = input$bins2)
    })
    
    output$distPlot <- renderPlot({
        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        
        bins <- seq(min(x), max(x), length.out = input$bins1 + 1)

        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

No. I have a text field that updates a reactiveValues entry "name", and then I have a renderPlot that is observing that reactiveValues entries and writes the plot. However, before doing so, it checks various values, including the "name" entry for validity. This seems to trigger some kind of loop when I write text in the text field faster than the plot rendering to complete. It starts bouncing between the old text and the new text

its hard to help you without a reprex. I was hopeful that my simple start could be adapted to your issue. (i.e. your renderplot might be a simple histogram etc.).

Anyways, perhaps you would benefit from a debounce type approach to have your plot wait to render until its inputs stop changing above a certain frequency. https://shiny.rstudio.com/reference/shiny/1.0.4/debounce.html

1 Like

I'm trying to disentangle the code to the bare minimum. It's not easy. Give me 10 minutes.

This should show the issue:

AppModel <- function() {
  self <- reactiveValues(
      name = NULL
    )

  return(self)
}

AppModel_checkCompleteness <- function(self) {
    incomplete <- list(
      name = NULL,
      completed = TRUE
    )

    if (is.null(self$name) || stringr::str_length(stringr::str_trim(self$name)) == 0) {
      incomplete$name <- "You have not specified your name"
      incomplete$completed <- FALSE;
    }

    return(incomplete)
}


ui <- function() {
  view <- wellPanel(
    style="width: 70%; margin-left: auto; margin-right: auto",
    textInput(
      "nameText",
      "Your name and surname",
      placeholder="Please write your name and surname"),
    uiOutput("checklistUi"),
  )
  return(view)
}

server <- function(input, output, session) {
  app_model <- AppModel()

  .generateChecklistUi <- function() {
    Sys.sleep(2)

    completion_widget <- "Hello"

    completed <- AppModel_checkCompleteness(app_model)

    return(completion_widget)
  }

  observeEvent({input$nameText},
  {
    app_model$name <- input$nameText
  })

  observeEvent({app_model$name},
  {
    updateTextInput(session, "nameText", value = app_model$name)
  })

  observeEvent({
    completeness <- AppModel_checkCompleteness(app_model)
    return(completeness$completed)
  },
  {
    output$checklistUi <- renderUI(.generateChecklistUi())
  })
}

shinyApp(ui = ui, server = server)

To trigger it, you might have to play with it. Try to type a lot of letters (keep your letter pressed) while the hello is "grey" due to reprocessing. Keep adding or removing letters and sooner or later it will enter into a loop where it keep going back and forth between two states of the text.

Note that I tried to isolate the call to checkCompleteness, but then I don't get actual completeness check when I reload my model content from the disk. besides, I don't see how it would create a problem.

Edit: I reduced it even more: replace the server with

server <- function(input, output, session) {                                              
  app_model <- AppModel()                                                                 
                                                                                          
  output$checklistUi <- renderUI({                                                        
    Sys.sleep(2)                                                                          
                                                                                          
    completion_widget <- "Hello"                                                          
                                                                                          
    completed <- AppModel_checkCompleteness(app_model)                                    
                                                                                          
    return(completion_widget)                                                             
  })                                                                                      
                                                                                          
  observeEvent({input$nameText},                                                          
  {                                                                                       
    app_model$name <- input$nameText                                                      
  })                                                                                      
                                                                                          
  observeEvent({app_model$name},                                                          
  {                                                                                       
    updateTextInput(session, "nameText", value = app_model$name)                          
  })                                                                                      
}

The reason why app_model should impose its truth on the textfield is eluding me, but the fundamental issue here, is one of business logic.
Just what should decide the values ?
as you type in the box, that updates quickly, and should propogate to the model.
but early changes to the model are pushed to the textfield and overwride more recent changes.

A conventional solution, would be to disable, character by character updates on the text field, and make the update from text field to model be based on a single button press. in this way at least, all key presses that compose the change in the text field contents can be processed at once

AppModel <- function() {
  self <- reactiveValues(
    name = NULL
  )
  
  return(self)
}

AppModel_checkCompleteness <- function(self) {
  incomplete <- list(
    name = NULL,
    completed = TRUE
  )
  
  if (is.null(self$name) || stringr::str_length(stringr::str_trim(self$name)) == 0) {
    incomplete$name <- "You have not specified your name"
    incomplete$completed <- FALSE;
  }
  
  return(incomplete)
}


ui <- function() {
  view <- wellPanel(
    style="width: 70%; margin-left: auto; margin-right: auto",
    textInput(
      "nameText",
      "Your name and surname",
      placeholder="Please write your name and surname"),
    actionButton("nameTextButton","submit/sync"),
    textOutput("model_content"),
    uiOutput("checklistUi"),
  )
  return(view)
}

server <- function(input, output, session) {
  app_model <- AppModel()
  
  .generateChecklistUi <- function() {
    Sys.sleep(2)
    
    completion_widget <- "Hello"
    
    completed <- AppModel_checkCompleteness(app_model)
    
    return(completion_widget)
  }
  
  observeEvent({input$nameTextButton},
               {
                 
                 app_model$name <- req(input$nameText)
               })
  
  observeEvent({app_model$name},
               {
                 updateTextInput(session, "nameText", value = app_model$name)
               })
  
  observeEvent({
    completeness <- AppModel_checkCompleteness(app_model)
    return(completeness$completed)
  },
  {
    output$checklistUi <- renderUI(.generateChecklistUi())
  })
  
  output$model_content <- renderPrint(app_model$name)
}

shinyApp(ui = ui, server = server)

The reason why the information is pushed back to the textfield is because the model is both set by the user via the UI, but also potentially restored from a saved file, so I need to push the content of the model after the load.

Just what should decide the values ? as you type in the box, that updates quickly, and should propogate to the model. but early changes to the model are pushed to the textfield and overwride more recent changes.

The problem happens when a second change is performed while the initial transaction is in progress. The response not only updates the "hello" widget, but also forces update on the textedit

{"errors":{},"values":{"checklistUi":{"html":"Hello","deps":}},"inputMessages":[{"id":"nameText","message":{"value":"a"}}]}

The inputMessages of the response ends up setting the textedit, but since the new transaction is now in progress, the state starts to bounce between the two.

A conventional solution, would be to disable, character by character updates on the text field, and make the update from text field to model be based on a single button press.

I can't do that. The UI design is made so that it works seamlessly without any button press.

ok, that makes sense that the model may be restored from a file and that the UI should be populated from that.

But what determines such a reload ? presumably its a button press event... So the update from model to text best happen as a part of the special restore from save activity, rather than be a constant stream in competition with keypress updates ?

Ok, but I am not going to populate a button handler with a massive amount of code to push the updated changes to every individual UI widget of my application. The button handler should just update the model, and then whoever is listening to that model will do what it's supposed to do: synchronize.

Edit: I am going to take a walk and think about a solution. Thank you for helping me. I'll be back in 5-10 minutes.

If there is a more egelant/powerfull approach to be found, id be happy to explore the ideas with you.
I think we are up to this proposal:

AppModel <- function() {
  self <- reactiveValues(
    name = NULL
  )

  return(self)
}

AppModel_checkCompleteness <- function(self) {
  incomplete <- list(
    name = NULL,
    completed = TRUE
  )

  if (is.null(self$name) || stringr::str_length(stringr::str_trim(self$name)) == 0) {
    incomplete$name <- "You have not specified your name"
    incomplete$completed <- FALSE
  }

  return(incomplete)
}


ui <- function() {
  view <- wellPanel(
    style = "width: 70%; margin-left: auto; margin-right: auto",
    textInput(
      "nameText",
      "Your name and surname",
      placeholder = "Please write your name and surname"
    ),
    textInput(
      "simulatesaved",
      "simulatesaved",
      value = "john Smith"
    ),
    actionButton("restore_from_saved", "restore from saved"),
    textOutput("model_content"),
    uiOutput("checklistUi"),
  )
  return(view)
}

server <- function(input, output, session) {
  app_model <- AppModel()

  .generateChecklistUi <- function() {
    Sys.sleep(2)



    completed <- AppModel_checkCompleteness(app_model)

    if (completed$completed) {
      completion_widget <- paste0("model content: ", app_model$name)
    } else {
      completion_widget <- "model content: not valid"
    }
    return(completion_widget)
  }


  observeEvent(input$nameText, {
    app_model$name <- req(input$nameText)
  })

  observeEvent(input$restore_from_saved, {
    app_model$name <- input$simulatesaved
    updateTextInput(
      session = session,
      inputId = "nameText",
      value = app_model$name
    )
  })

  observeEvent(
    {
      completeness <- AppModel_checkCompleteness(app_model)
      return(completeness$completed)
    },
    {
      output$checklistUi <- renderUI(.generateChecklistUi())
    }
  )

  output$model_content <- renderPrint(app_model$name)
}

shinyApp(ui = ui, server = server)

but you had a concern about volume of code to push changes to individual UI widgets

Do you know if it's possible to disable the UI completely until the transaction is completed, or at least prevent it from sending other events until the browser gets the idle message?

no, i've not come across anything like that

I think I'll file a bug because in my opinion it is a bug. The UI should not enqueue new events until the previous events have been processed.

Here is a workaround using debounce:

AppModel <- function() {
  self <- reactiveValues(
    name = NULL
  )
  
  return(self)
}

AppModel_checkCompleteness <- function(self) {
  incomplete <- list(
    name = NULL,
    completed = TRUE
  )
  
  if (is.null(self$name) || stringr::str_length(stringr::str_trim(self$name)) == 0) {
    incomplete$name <- "You have not specified your name"
    incomplete$completed <- FALSE;
  }
  
  return(incomplete)
}


ui <- function() {
  view <- wellPanel(
    style="width: 70%; margin-left: auto; margin-right: auto",
    textInput(
      "nameText",
      "Your name and surname",
      placeholder="Please write your name and surname"),
    uiOutput("checklistUi"),
  )
  return(view)
}

server <- function(input, output, session) {                                              
  
  nameText <- debounce(reactive({input$nameText}), 500)
  
  app_model <- AppModel()
  
  output$checklistUi <- renderUI({                                                        
    Sys.sleep(2)                                                                          
    
    completion_widget <- "Hello"                                                          
    
    completed <- AppModel_checkCompleteness(app_model)                                    
    
    return(completion_widget)                                                             
  })                                                                                      
  
  observeEvent({nameText()},                                                          
               {                                                                                       
                 app_model$name <- nameText()                                                     
               })                                                                                      
  
  observeEvent({app_model$name},
               {
                 updateTextInput(session, "nameText", value = app_model$name)
               })
}

shinyApp(ui = ui, server = server)

It's a workaround that works only because it hides the issue. You are just introducing another delay to compensate the processing delay.

Yes.. thats why I called it a workaround. However, it doesn't hide the issue, it prevents triggering the infinite loop (debounce time < processing time). My first thought here was: use a button. Second thought: stop using inputs as outputs.

So it's not clear to me why it's working. I guess that if one triggers a new letter within 500 ms, then it neutralises it, but if it is triggered at 501ms or above, it will not be effective. Do I understand correctly?

Alternatively, is there a way to send the change event of the textInput only on focus out?

I don't see why. If I recover data from the disk, I need to be able to set an input to the recovered state. It's a common feature of any UI framework.

I think this is plausible, here is an article on custom inputs. I expect a js callback could be placed on a focus out event. https://shiny.rstudio.com/articles/js-custom-input.html

You got me thinking that your use case may be covered by the bookmark features ?
https://shiny.rstudio.com/articles/bookmarking-state.html

To analyse your apps behaviour in depth please see reactlog: options(shiny.reactlog = TRUE).

To recover inputs from disk I'd look at bookmarking (Just seeing @nirgrahamuk mentioning the same while typing.)

Regarding "event on focus out" you can check onevent from library(shinyjs).