为不同选项卡面板中的相同值设置两个 RShiny 输入值

Question

我有一个使用 navBarPage 的 RShiny 应用程序，类似于：

default_run_date = Sys.Date()
ui <- navbarPage(
  "MyTitle",
  id="mainNavbarPage"
  ),
  tabPanel(
    "Panel1",
    fluidPage(
        dateInput("datePicker1",
                           "Run date:",
                           value = default_run_date,max = Sys.Date())
  ),
  tabPanel(
    "Panel2",
    fluidPage(
        dateInput("datePicker2",
                           "Run date:",
                           value = default_run_date,max = Sys.Date())
  )
)

我实际上有 5-6 个不同的选项卡，我希望用户能够更改在所有这些选项卡上应用设置的日期。为了方便起见，我希望用户在访问两个不同选项卡中的任何一个时都拥有此控件。

我试过设置一对观察者：

observeEvent(input$datePicker1,{updateDateInput(session,inputId ="datePicker2",value=input$datePicker1)})
observeEvent(input$datePicker2,{updateDateInput(session,inputId ="datePicker1",value=input$datePicker2)})

然而，这些事件中的每一个实际上都会触发另一个，从而导致无限循环。

谁能告诉我更好的处理方法？

Answer 1

将所选日期存储在 reactiveVal 中。然后在 reactiveVal 更改时使用 renderUI 重新创建日期选择器。

library(shiny)

ui <- navbarPage("MyTitle", id="mainNavbarPage",
                 tabPanel("Panel1", uiOutput("date_ui_1")),
                 tabPanel("Panel2", uiOutput("date_ui_2")))

server <- function(input, output, session){
  
  # Default starting value for date pickers
  date_chosen <- reactiveVal(Sys.Date())
  
  output$date_ui_1 <- renderUI({
    dateInput("datePicker1",
              "Run date:",
              value = date_chosen(),
              max = Sys.Date())
  })
  
  output$date_ui_2 <- renderUI({
    dateInput("datePicker2",
              "Run date:",
              value = date_chosen(),
              max = Sys.Date())
  })
  
  observeEvent(input$datePicker1, {
    date_chosen(input$datePicker1)
  })
  observeEvent(input$datePicker2, {
    date_chosen(input$datePicker2)
  })
}

shinyApp(ui = ui, server = server)

Answer 2

在这种情况下，我不会使用 renderUI，因为必须在服务器端呈现完整的 dateInput。这会导致更新值的延迟，这在这个玩具示例中已经可见。 This blog post 描述了为什么使用 updateInput 并在客户端进行更改会更快。您可以在此处应用此方法，如下所示：

library(shiny)

ui <- navbarPage("MyTitle", id="mainNavbarPage",
                 tabPanel("Panel1", dateInput("datePicker1",
                                              "Run date:",
                                              value = Sys.Date(),
                                              max = Sys.Date())),
                 tabPanel("Panel2", dateInput("datePicker2",
                                              "Run date:",
                                              value = Sys.Date(),
                                              max = Sys.Date())))

server <- function(input, output, session){
  
  # Default starting value for date pickers
  date_chosen <- reactiveVal(Sys.Date())
  
  observeEvent(input$datePicker1, {
    date_chosen(input$datePicker1)
  })
  observeEvent(input$datePicker2, {
    date_chosen(input$datePicker2)
  })
  
  observeEvent(date_chosen(), {
    updateDateInput(session,
                    "datePicker1",
                    value = date_chosen())
    updateDateInput(session,
                    "datePicker2",
                    value = date_chosen())
  })
}

shinyApp(ui = ui, server = server)

为不同选项卡面板中的相同值设置两个 RShiny 输入值

Setting up two RShiny input values for the same value across different tab panels

shiny

shiny-reactivity

shinyjs