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)
    })
  }
)

或者，当您使用 Shiny 的仪表板时，您实际上可以在侧边栏中添加该控件，如果需要的话，也可以在一组选项卡下的其自己的行中添加该控件。

我想不出有多个输入自动选择相同内容的原因。除了减慢你的应用程序速度之外，我看不到任何好处。但如果您坚持，您可以使用 reactiveVal 将选定的选择设为 react 值，并使用例如 observeEvent() 来更新该 react 值。使用 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)