вкладка конкретной боковой панели в shinydashboard

Question

Я использую пакет shinyjs в R, чтобы разрешать события типа onclick, чтобы перемещаться между вкладками в табуляции. Каждая вкладка имеет определенную боковую панель, и есть несколько (двух) способов перехода между каждой вкладкой (т. Е. Путем нажатия на саму вкладку или путем нажатия на значенияBoxes). Я хотел бы убедиться, что независимо от того, каким способом вы попадаете на конкретную вкладку, загружается правильная боковая панель.

# 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

Прямо сейчас это не выглядит, как у вас есть какой-либо логики в вашем коде, который говорит ползунок обновления при переключении вкладки, только при щелчке значенияBox.

Существуют различные подходы к этому.

Вариант 1: прослушивание при изменении NavBar и использовании toggle() с condition

Это очень похоже на ваш код, но вместо вызова функции toggle() всякий раз, когда есть щелчок, я все OnClick является измените выбранную вкладку. Когда значение вкладки изменяется (либо нажатием на значениеBox, либо нажатием на вкладку), тогда вызовите функцию 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)