Update Shiny input to match other Shiny input: infinite loop - r

Question

I would like to have two instances of an input controller in my Shiny app, but I think that what I have to do instead is to have two inputs and update the value of each whenever the other changes. This way, they will appear to the user to be the same controls despite the fact that they have different IDs.
I anticipate being told to not do what I am trying to do, but the use case is that I have many tabs in a dashboardPage(), and only two of them share controls. Thus, putting the controls for those two pages in the sidebar would be confusing to the user.
I made a simple, working example of how to do this (using a dashboard to make it more clear why I want to do this) based on a closely-related question that was answered by convincing the asker to do something else (which worked in their case but not in mine). The app works fine except that as it gets more and more complex, the calculations take long enough sometimes that I can change one input and then change the other before the Shiny server has had time to update the values. This results in infinite feedback (input 1 updates to match input 2 while input 2 is updating to match input 1, and then this repeats for as long as I care to watch).
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Tab 1", tabName = "tab1", icon = icon("chart-line")),
menuItem("Tab 2", tabName = "tab2", icon = icon("chart-line")),
menuItem("Other Tab", tabName = "tab3", icon = icon("project-diagram"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "tab1",
# Input first number
numericInput("input1", label = "Input 1", value = 1, min=1, step=1)
),
# Second tab content
tabItem(tabName = "tab2",
# Input second number
numericInput("input2", label = "Input 2", value = 1, min=1, step=1)
),
# Third tab content
tabItem(tabName = "tab3", "Unrelated content")
)
)
)
server = function(input, output, session) {
# Update inputs to match each other
observeEvent(input$input1, {
updateSelectInput(session = session,
inputId = "input2",
selected = input$input1)})
observeEvent(input$input2, {
updateSelectInput(session = session,
inputId = "input1",
selected = input$input2)})
}
shinyApp(ui = ui, server = server)
The question: what other ways are there to have separate pages with matching controls that control both pages but without having to put those controls on every page? Sub-question: is any of these methods going to avoid the infinite loop problem? Corollary: I saw an article that I think was rendering UI pages from auxiliary scripts and passing the input arguments to the URLs for those scripts, and that seemed like a great strategy, but I cannot find the article now and am struggling to figure it out on my own.

Answer 1

It is much simpler in fact. Instead of observing the numeric inputs, you can observe what tab is selected, and update a particular numericInput when the user arrives at that tab. So all we need is to provide an id for the sidebarMenu (id = "tabs", ...) and to observe the contents of this input variable:
observe({
if (req(input$tabs) == "tab2") {
updateSelectInput(...)
}
})
Changing input values with keyboard:
Changing input values with mouse clicking on up arrow:
Changing to tab2 while tab1 is rendering though the list of clicks:
Updated code:
library(shiny)
library(shinydashboard)
ui = dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Tab 1", tabName = "tab1", icon = icon("chart-line")),
menuItem("Tab 2", tabName = "tab2", icon = icon("chart-line")),
menuItem("Other Tab", tabName = "tab3", icon = icon("project-diagram"))
)
),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "tab1",
# Input first number
numericInput("input1", label = "Input 1", value = 1000, min=1, step=1),
plotOutput("plot1")
),
# Second tab content
tabItem(tabName = "tab2",
# Input second number
numericInput("input2", label = "Input 2", value = 1000, min=1, step=1),
plotOutput("plot2")
),
# Third tab content
tabItem(tabName = "tab3", "Unrelated content")
)
)
)
server = function(input, output, session) {
# some (not so) long computation
long_comp1 <- reactive({
x <- sample(input$input1, size=10000000, replace = TRUE)
y <- sample(input$input1, size=10000000, replace = TRUE)
m <- matrix(x, nrow = 500, ncol=200)
n <- matrix(y, nrow = 200, ncol=500)
p <- n %*% m
p
})
output$plot1 <- renderPlot({
hist(long_comp1(), main = paste("input1 is", input$input1))
})
# some (not so) long computation
long_comp2 <- reactive({
x <- sample(input$input2, size=10000000, replace = TRUE)
y <- sample(input$input2, size=10000000, replace = TRUE)
m <- matrix(x, nrow = 500, ncol=200)
n <- matrix(y, nrow = 200, ncol=500)
p <- n %*% m
p
})
output$plot2 <- renderPlot({
hist(long_comp2(), main = paste("input2 is", input$input2))
})
# Update inputs to match each other
observe({
if (req(input$tabs) == "tab2") {
updateSelectInput(session = session,
inputId = "input2",
selected = input$input1)
}
})
observe({
if (req(input$tabs) == "tab1") {
updateSelectInput(session = session,
inputId = "input1",
selected = input$input2)
}
})
}
shinyApp(ui = ui, server = server)