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()函数，我所做的只是更改选定的选项卡。当选项卡值更改时（通过单击valueBox或单击选项卡），然后调用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)

shinydashboard

1 个答案: