updateTabsetPanel для навигации между вложенными tabsetPanels в приложении Shiny

Question

Я хотел бы иметь возможность использовать actionLink для перехода к tabPanel с в пределах вложенных tabsetPanel с. В настоящее время я могу перейти к конкретному tabPanel, только если у меня уже есть родительский tabPanel. Эта номенклатура довольно быстро запутывается, поэтому вот пример, который вложил tabPanels и два actionLink с, чтобы перейти к двум дочерним элементам tabPanel s:

library(shiny)

ui <- {
    fluidPage(
        fluidRow(
            column(3,
                actionLink('subpanel_1a', 'Go to 1 A'),
                br(),
                actionLink('subpanel_1b', 'Go to 1 B')
            ),
            column(9,
                tabsetPanel(id = 'master_panel',
                    tabPanel('Primary panel 1',
                        tabsetPanel(id = 'primary_panel_1',
                            tabPanel('subpanel_1_a'),
                            tabPanel('subpanel_1_b')
                        )
                    ),
                    tabPanel('Primary panel 2',
                        tabsetPanel(id = 'primary_panel_2',
                            tabPanel('subpanel_2_a'),
                            tabPanel('subpanel_2_b')
                        )
                    )
                )
            )
        )
    )
}

server <- function(input, output, session) {
    observeEvent(input$subpanel_1a, {
        updateTabsetPanel(session, 'primary_panel_1', 'subpanel_1_a')
    })
    observeEvent(input$subpanel_1b, {
        updateTabsetPanel(session, 'primary_panel_1', 'subpanel_1_b')
    })
}

shinyApp(ui, server)

actionLink s«Перейти к 1 A» и «Перейти к 1 B» работают только в том случае, если текущий родительский элемент tabPanel является «Первичной панелью 1» - они не работают, если вы находитесь в «Первичной панели 2».

Есть ли способ обойти это поведение, чтобы actionLink s работал независимо от выбранной в данный момент панели?

Answer 1

Вы можете использовать ту же "логику обновления" для master_panel перед обновлением подпанели.

Так что для 2a это будет выглядеть так:

observeEvent(input$subpanel_2a, {
    updateTabsetPanel(session, inputId = 'master_panel', selected = 'Primary panel 2')
    updateTabsetPanel(session, inputId = 'primary_panel_2', selected = 'subpanel_2_a')
  })

Воспроизводимыйкод:

library(shiny)

ui <- {
  fluidPage(
    fluidRow(
      column(3,
             actionLink('subpanel_1a', 'Go to 1 A'),
             br(),
             actionLink('subpanel_1b', 'Go to 1 B'),
             br(),
             actionLink('subpanel_2a', 'Go to 2 A'),
             br(),
             actionLink('subpanel_2b', 'Go to 2 B')
      ),
      column(9,
             tabsetPanel(id = 'master_panel',
                         tabPanel('Primary panel 1',
                                  tabsetPanel(id = 'primary_panel_1',
                                              tabPanel('subpanel_1_a'),
                                              tabPanel('subpanel_1_b')
                                  )
                         ),
                         tabPanel('Primary panel 2',
                                  tabsetPanel(id = 'primary_panel_2',
                                              tabPanel('subpanel_2_a'),
                                              tabPanel('subpanel_2_b')
                                  )
                         )
             )
      )
    )
  )
}

server <- function(input, output, session) {
  observeEvent(input$subpanel_1a, {
    updateTabsetPanel(session, inputId = 'master_panel', selected = 'Primary panel 1')
    updateTabsetPanel(session, inputId = 'primary_panel_1', selected = 'subpanel_1_a')
  })

  observeEvent(input$subpanel_1b, {
    updateTabsetPanel(session, inputId = 'master_panel', selected = 'Primary panel 1')
    updateTabsetPanel(session, inputId = 'primary_panel_1', selected = 'subpanel_1_b')
  })

  observeEvent(input$subpanel_2a, {
    updateTabsetPanel(session, inputId = 'master_panel', selected = 'Primary panel 2')
    updateTabsetPanel(session, inputId = 'primary_panel_2', selected = 'subpanel_2_a')
  })

  observeEvent(input$subpanel_2b, {
    updateTabsetPanel(session, inputId = 'master_panel', selected = 'Primary panel 2')
    updateTabsetPanel(session, inputId = 'primary_panel_2', selected = 'subpanel_2_b')
  })
}

shinyApp(ui, server)

Следуя этому пути, вы можете создать довольно повторяющийся код.

В зависимости от количества имеющихся у вас панелей и подпанелей, вы можете попробовать выбрать имена, которые позволятВы избегаете очень повторяющегося кода для этих обновлений. Так что если у вас есть panel_1 и panel_1_a до panel_5 и panel_5_d. Вы можете динамически читать «уровни» из строк. Логика будет panel_{FIRSTLEVELNR}_{SECONDLEVELNR}. Затем вы можете использовать sthg, например:

library(magrittr)
levels = panel_{FIRSTLEVELNR}_{SECONDLEVELNR} >%> strsplit(split = "_") %>% unlist
updateTabsetPanel(session, inputId = 'master_panel', selected = levels[2])
updateTabsetPanel(session, inputId = 'primary_panel_1', selected = levels[3])

, динамически для всех панелей + субпанелей, вместо того, чтобы повторять это 20 раз. Но, как я уже сказал, это зависит от количества вашей панели + субпанели и желаемых соглашений об именах.