R Shiny 在多个选项卡上同步过滤器

Question

我构建了一个带有多个选项卡的 R Shiny 应用程序，这些选项卡有一些共同的过滤器。目前，所有过滤器都是独立的，不会跨多个选项卡同步。因此，当我将 selectInput1 从值“a”更改为值“b”时，我必须在包含具有相同选项/含义的 selectInput2 的下一个选项卡上重复此处理。

我考虑过让过滤器动态化，因此使用 R Shiny 的服务器端渲染它们。那么当然，我总是可以让 selectInput2 等于 selectInput1。但是如果用户更改了 selectInput2 而不是 selectInput1 怎么办？它在逻辑中创建了一种循环。

我花了很长时间为这个问题寻找解决方案，不知何故我确定我不是第一个遇到这个问题的人。建议或有用的链接将非常有帮助！

例子：

## UI.R
shinyUI(
  dashboardPage("Dashboard",

    # Create tabs
    tabPanel("Start",
             p("This is the frontpage")
    ),
    tabPanel("tab1",
             uiOutput("selectInput1")
    ),
    tabPanel("tab2",
             uiOutput("selectInput2")
    )
  )
)

和：

## Server.R
library(shiny)

shinyServer(function(input, output,session){
  output$selectInput1 <- renderUI({
    selectInput(inputId = "id1", 
                label = "select", 
                choices = c("a","b","c"), 
                selected = "a")
  })

  output$selectInput2 <- renderUI({
    selectInput(inputId = "id2", 
                label = "select", 
                choices = c("a","b","c"), 
                selected = "a")
  })
})

Answer 1

我个人会使用单个输入控件来控制不同的选项卡面板。一种方法是在您的选项卡下包含该单个输入：

shinyApp(
  fluidPage(
    fluidRow(
      tabsetPanel(
        tabPanel("Tab1",
                 verbatimTextOutput("choice1")),
        tabPanel("Tab2",
                 verbatimTextOutput("choice2"))
      )
    ),
    fluidRow(
      selectInput("id1", "Pick something",
                  choices = c("a","b","c"),
                  selected = "a")
    )
  ),
  function(input, output, session){
    output$choice1 <- renderPrint(input$id1)
    output$choice2 <- renderPrint({
      paste("The choice is:", input$id1)
    })
  }
)

或者，当您使用闪亮仪表板时，您实际上可以将该控件添加到侧边栏中，如果必须的话，可能会再次在一组选项卡下的自己的行中添加。

我想不出让多个输入自动选择同一事物的理由。除了减慢您的应用程序之外，我看不到任何收益。但是，如果您坚持，您可以使用reactiveVal 将选定的选项设置为反应值，然后使用例如observeEvent() 来更新该反应值。一个使用shinydashboard的小例子：

library(shinydashboard)
library(shiny)
ui <- shinyUI(
  dashboardPage(title = "Dashboard",
                dashboardHeader(),
                dashboardSidebar(
                  tabsetPanel(
                  tabPanel("tab1",
                           uiOutput("selectInput1")
                  ),
                  tabPanel("tab2",
                           uiOutput("selectInput2")
                  )
                )),
                dashboardBody(
                  verbatimTextOutput("selected")
                )
  )
)

server <- shinyServer(function(input, output,session){

  thechoice <- reactiveVal("a")  
  output$selectInput1 <- renderUI({
    selectInput(inputId = "id1", 
                label = "select", 
                choices = c("a","b","c"), 
                selected = thechoice())
  })
  output$selectInput2 <- renderUI({
    selectInput(inputId = "id2", 
                label = "select", 
                choices = c("a","b","c"), 
                selected = thechoice())
  })

  observeEvent(input$id2,{
    thechoice(input$id2)
  })

  observeEvent(input$id1,{
    thechoice(input$id1)
  })

  output$selected <- renderPrint({
    c(input$id1, input$id2)
  })
})

shinyApp(ui, server)