更新 Shiny 输入以匹配其他 Shiny 输入：无限循环

Question

我想在我的 Shiny 应用程序中有两个输入控制器实例，但我认为我必须做的是拥有两个输入并在另一个发生变化时更新每个输入的值。这样，尽管它们具有不同的 ID，但对用户而言它们将显示为相同的控件。

我预计会被告知不要做我想做的事情，但用例是我在 dashboardPage() 中有很多选项卡，并且只有两个选项卡共享控件。因此，将这两个页面的控件放在侧边栏中会使用户感到困惑。

我根据一个说服提问者去做的回答，做了一个简单的工作示例来说明如何做到这一点（使用仪表板更清楚地说明我为什么要这样做）其他东西（在他们的情况下有效但在我的情况下无效）。该应用程序运行良好，但随着它变得越来越复杂，有时计算会花费足够长的时间，以至于我可以更改一个输入，然后在 Shiny 服务器有时间更新值之前更改另一个输入。这导致无限反馈（输入 1 更新以匹配输入 2，而输入 2 更新以匹配输入 1，然后只要我愿意观看就会重复）。

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)

问题：还有哪些其他方法可以使单独的页面具有控制两个页面的匹配控件，而不必将这些控件放在每个页面上？子问题：这些方法中的任何一种都可以避免无限循环问题吗？推论：我看到一篇文章，我认为是从辅助脚本渲染 UI 页面并将输入参数传递给这些脚本的 URL，这似乎是一个很好的策略，但我现在找不到这篇文章并且正在努力自己想办法。

Answer 1

其实更简单。您可以观察选择了哪个选项卡，并在用户到达该选项卡时更新特定的 numericInput，而不是观察数字输入。所以我们只需要为 sidebarMenu (id = "tabs", ...) 提供一个 id 并观察这个输入变量的内容：

observe({
    if (req(input$tabs) == "tab2") {
      updateSelectInput(...)
    }
  })

使用键盘更改输入值：

通过鼠标单击向上箭头更改输入值：

在通过点击列表呈现 tab1 时更改为 tab2：

更新代码：

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)

更新 Shiny 输入以匹配其他 Shiny 输入：无限循环

Update Shiny input to match other Shiny input: infinite loop

r

shiny

shinydashboard

shiny-reactivity