Shinydashboard 中特定于选项卡的侧边栏

Question

我shinyjs在 R 中使用包来允许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)