闪亮仪表板中的选项卡特定侧边栏

Question

我在 R 中使用 shinyjs 包以允许 onclick 类型事件在选项卡集中的选项卡之间导航。每个选项卡都有一个特定的侧边栏，并且在每个选项卡之间有多种（两种）获取方式（即通过单击选项卡本身或单击 valueBoxes）。我想确保无论您以何种方式进入特定选项卡，都能加载正确的侧边栏。

# load libraries
require(shiny)
require(shinydashboard)
require(shinyjs)

# create a simple app
ui <- dashboardPage(
  title='Loading graphs',
  dashboardHeader(
    title = 'Loading Graphs'
  ),
  dashboardSidebar(
    div(id='tab1_sidebar',
        sliderInput('tab1_slider', 'tab1 slider', min=2,max=7,value=2)),
    shinyjs::hidden(
      div(id='tab2_sidebar',
          sliderInput('tab2_slider', 'tab2 slider', min=2,max=7,value=2))
      )
  ),
  dashboardBody(
    useShinyjs(),
    tabsetPanel(
      id = "navbar",
      tabPanel(title="tab1 title",id="tab1",value='tab1_val',
               valueBoxOutput('tab1_valuebox')),
      tabPanel(title="tab2 title",id="tab2",value='tab2_val',
               valueBoxOutput('tab2_valuebox'))
    )
  )
)

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

  output$tab1_valuebox <- renderValueBox({
    valueBox('1000',subtitle = "blah blah",icon = icon("car"),
             color = "blue"
    )
  })

  output$tab2_valuebox <- renderValueBox({
    valueBox('2000',subtitle = "blah2 blah2",icon = icon("car"),
             color = "red"
    )
  })



  # on click of a tab1 valuebox
  shinyjs::onclick('tab1_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab2_val')
    # update the sidebar to match the tab
    toggle('tab1_sidebar')
    toggle('tab2_sidebar')
  })

  # on click of a tab2 valuebox
  shinyjs::onclick('tab2_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab1_val')
    # update the sidebar to match the tab
    toggle('tab1_sidebar')
    toggle('tab2_sidebar')
  })
})

shinyApp(ui=ui,server=server)

在上面的代码中，单击选项卡时侧边栏不会改变，但如果我将以下代码包含到服务器组件中以允许单击选项卡，它似乎无法正确调整...

# change sidebar based on navbar value....
observeEvent(input$navbar,{
  if(input$navbar=='tab1_val'){
      toggle('tab1_sidebar')
      toggle('tab2_sidebar')
  } else if(input$navbar=='tab2_val'){
      toggle('tab1_sidebar')
      toggle('tab2_sidebar')
  }
})

对此的任何帮助将不胜感激......

Answer 1

现在看起来您的代码中没有任何逻辑告诉滑块在您切换选项卡时更新，只有在单击 valueBox 时才更新。

您可以采用不同的方法来解决此问题。

选项 1：在导航栏更改时进行监听并将toggle() 与condition 结合使用

这与您的代码非常相似，但不是在单击时调用toggle() 函数，而是在单击时更改选定的选项卡。当标签值更改时（通过单击值框或通过单击选项卡），然后调用toggle()函数。微小但重要的区别。

# load libraries
require(shiny)
require(shinydashboard)
require(shinyjs)

# create a simple app
ui <- dashboardPage(
  title='Loading graphs',
  dashboardHeader(
    title = 'Loading Graphs'
  ),
  dashboardSidebar(
    div(id='tab1_sidebar',
        sliderInput('tab1_slider', 'tab1 slider', min=2,max=7,value=2)),
    shinyjs::hidden(
      div(id='tab2_sidebar',
          sliderInput('tab2_slider', 'tab2 slider', min=2,max=7,value=2))
    )
  ),
  dashboardBody(
    useShinyjs(),
    tabsetPanel(
      id = "navbar",
      tabPanel(title="tab1 title",id="tab1",value='tab1_val',
               valueBoxOutput('tab1_valuebox')),
      tabPanel(title="tab2 title",id="tab2",value='tab2_val',
               valueBoxOutput('tab2_valuebox'))
    )
  )
)

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

  values <- reactiveValues(selectedTab = 1)

  observeEvent(input$navbar, {
    toggle("tab1_sidebar", condition = input$navbar == "tab1_val")
    toggle("tab2_sidebar", condition = input$navbar == "tab2_val")
  })

  output$tab1_valuebox <- renderValueBox({
    valueBox('1000',subtitle = "blah blah",icon = icon("car"),
             color = "blue"
    )
  })

  output$tab2_valuebox <- renderValueBox({
    valueBox('2000',subtitle = "blah2 blah2",icon = icon("car"),
             color = "red"
    )
  })



  # on click of a tab1 valuebox
  shinyjs::onclick('tab1_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab2_val')
  })

  # on click of a tab2 valuebox
  shinyjs::onclick('tab2_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab1_val')
  })
})

shinyApp(ui=ui,server=server)

选项 2：使用conditionalPanel()

作为shinyjs 的作者，我喜欢toggle 函数，但在这种情况下，它不是绝对必要的，您可以只使用conditionalPanel()。这是我认为你想要的代码：

# load libraries
require(shiny)
require(shinydashboard)
require(shinyjs)

# create a simple app
ui <- dashboardPage(
  title='Loading graphs',
  dashboardHeader(
    title = 'Loading Graphs'
  ),
  dashboardSidebar(
    conditionalPanel("input.navbar == 'tab1_val'",
      div(id='tab1_sidebar',
          sliderInput('tab1_slider', 'tab1 slider', min=2,max=7,value=2))
    ),
    conditionalPanel("input.navbar == 'tab2_val'",
      div(id='tab2_sidebar',
          sliderInput('tab2_slider', 'tab2 slider', min=2,max=7,value=2))
    )
  ),
  dashboardBody(
    useShinyjs(),
    tabsetPanel(
      id = "navbar",
      tabPanel(title="tab1 title",id="tab1",value='tab1_val',
               valueBoxOutput('tab1_valuebox')),
      tabPanel(title="tab2 title",id="tab2",value='tab2_val',
               valueBoxOutput('tab2_valuebox'))
    )
  )
)

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

  output$tab1_valuebox <- renderValueBox({
    valueBox('1000',subtitle = "blah blah",icon = icon("car"),
             color = "blue"
    )
  })

  output$tab2_valuebox <- renderValueBox({
    valueBox('2000',subtitle = "blah2 blah2",icon = icon("car"),
             color = "red"
    )
  })



  # on click of a tab1 valuebox
  shinyjs::onclick('tab1_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab2_val')
  })

  # on click of a tab2 valuebox
  shinyjs::onclick('tab2_valuebox',expr={
    # move to tab2
    updateTabsetPanel(session, "navbar", 'tab1_val')
  })
})

shinyApp(ui=ui,server=server)