shinydashboard 中选项卡特定的侧边栏

Question

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

# 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() 函数，我在点击时所做的只是更改所选选项卡。 When the tab value changes (either by clicking on a valueBox or by clicking on a tab), then call the toggle() function.小而重要的区别。

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

shinydashboard 中选项卡特定的侧边栏

tab specific sidebar in shinydashboard

r

shiny

shinydashboard

shinyjs