r - 为什么我无法返回到以前查看过的 Shiny 页面？

Question

我想知道为什么当我在 Shiny 的应用程序中打开一个页面(a1)，然后打开另一个页面(例如a2)时，我可以'不回到a1吗？

要重现我的示例，请按照下列步骤操作:

1. 点击a2
2. 点击b1
3. 点击c1
4. 点击c8
5. 再次点击c1

我希望再次看到 c1 的内容(“文本 2 的示例”)，但再次单击 c1 似乎没有任何反应。

library(shinydashboard)
library(shiny)

sidebar <- dashboardSidebar(
  tags$head(tags$style(
    HTML('.content-wrapper { height: 1500px !important;}')
  )),
  hr(),
  sidebarMenu(
    id = "tabs",
    menuItem(
      "a1",
      tabName = "principal",
      icon = icon("pagelines"),
      selected = TRUE
    ),
    menuItem(
      "a2",
      icon = icon("chart-bar"),
      menuSubItem("b1", tabName = "identificacion", icon = icon("angle-right")),
      menuSubItem("b2", tabName = "comunicacion", icon = icon("angle-right")),
      menuSubItem("b3", tabName = "medicamentos", icon = icon("angle-right")),
      menuSubItem("b4", tabName = "cirugias", icon = icon("angle-right")),
      menuSubItem("b5", tabName = "infecciones", icon = icon("angle-right")),
      menuSubItem("b6", tabName = "caidas", icon = icon("angle-right"))
    ),
    menuItem("a3", tabName = "procesos", icon = icon("chart-bar")),
    menuItem("a4", tabName = "tiempos", icon = icon("chart-bar")),
    menuItem("a5", tabName = "manual", icon = icon("mortar-board")),
    menuItem("a6", tabName = "acerca", icon = icon("question"))
  ),
  width = 285,
  hr(),
  conditionalPanel("input.tabs=='identificacion'",
                   fluidRow(
                     column(1),
                     column(
                       10,
                       menuItem(
                         "c1",
                         tabName = "admision_iden",
                         icon = icon("chart-line"),
                         selected = FALSE
                       ),
                       menuItem(
                         "c8",
                         tabName = "uci_iden",
                         icon = icon("chart-line"),
                         selected = FALSE
                       )
                     )
                   ))
)

body <- dashboardBody(tabItems(
  tabItem(tabName = "principal",
          withMathJax(), ("example of text")),

  tabItem(tabName = "admision_iden", titlePanel("example1"), "example of text 2"),

  tabItem(tabName = "uci_iden", titlePanel("example 2"), "example of text 3")
))

ui <- dashboardPage(dashboardHeader(title = "Indic", titleWidth = 285),
                    sidebar,
                    body)

server <- function(input, output) {}

runApp(list(ui = ui, server = server))

Answer 1

您的附加菜单在 sidebarMenu 外部呈现，因此在选择时，它们的 id 不会记录在输入变量 input$tabs 中(这是应用程序正在监视的内容)。在 sidebarMenu 中包含菜单允许 tabItems 跟踪 menuItems，但也会破坏 react 性，即当 input$tabs = 时= 'uci_iden' 附加菜单消失(因为 input$tabs != 'identificacion')。

---

实现您想要的行为的一种方法(可能不是最好的方法)是使用 renderUI 通过服务器呈现附加菜单。请注意，我们仍然必须在 sidebarMenu 中包含附加菜单，并通过 input$tabs 监视它们。为了确保它们在 input$tabs!= 'identificacion' 时保留下来，我们可以在条件中包含它们的 id。当 identification、uni_iden 或 admision_iden 均未选择时，我们会渲染一个空的 div。

---

更新的代码:

library(shinydashboard)
library(shiny)

sidebar <- dashboardSidebar(
  tags$head(tags$style(
    HTML('.content-wrapper { height: 1500px !important;}')
  )),
  hr(),
  sidebarMenu(
    id = "tabs",
    menuItem(
      "a1",
      tabName = "principal",
      icon = icon("pagelines"),
      selected = TRUE
    ),
    menuItem(
      "a2",
      icon = icon("chart-bar"),
      menuSubItem("b1", tabName = "identificacion", icon = icon("angle-right")),
      menuSubItem("b2", tabName = "comunicacion", icon = icon("angle-right")),
      menuSubItem("b3", tabName = "medicamentos", icon = icon("angle-right")),
      menuSubItem("b4", tabName = "cirugias", icon = icon("angle-right")),
      menuSubItem("b5", tabName = "infecciones", icon = icon("angle-right")),
      menuSubItem("b6", tabName = "caidas", icon = icon("angle-right"))
    ),
    menuItem("a3", tabName = "procesos", icon = icon("chart-bar")),
    menuItem("a4", tabName = "tiempos", icon = icon("chart-bar")),
    menuItem("a5", tabName = "manual", icon = icon("mortar-board")),
    menuItem("a6", tabName = "acerca", icon = icon("question")),
  width = 285,
  hr(),
  uiOutput("more_menus")
  )
)

body <- dashboardBody(tabItems(
  tabItem(tabName = "principal",
          withMathJax(), ("example of text")),

  tabItem(tabName = "admision_iden", titlePanel("example1"), "example of text 2"),

  tabItem(tabName = "uci_iden", titlePanel("example 2"), "example of text 3")
))

ui <- dashboardPage(dashboardHeader(title = "Indic", titleWidth = 285),
                    sidebar,
                    body)

server <- function(input, output) {

  make_menus <- reactive({
    if (req(input$tabs) %in% c("identificacion", "admision_iden", "uci_iden")) {
      fluidRow(column(1),
               column(
                 10,
                 menuItem(
                   "c1",
                   tabName = "admision_iden",
                   icon = icon("chart-line"),
                   selected = FALSE
                 ),
                 menuItem(
                   "c8",
                   tabName = "uci_iden",
                   icon = icon("chart-line"),
                   selected = FALSE
                 )
               ))
    } else {
      div()
    }
  })
  output$more_menus <- renderUI({ make_menus() })
}

runApp(list(ui = ui, server = server))