加载闪亮的应用程序时，如何避免在 sidebarMenu 中闪烁所有条件面板的初始加载？答案

【问题标题】：How to avoid initial loading with flickering of all conditionalPanels in sidebarMenu while Shiny Application loads?加载闪亮的应用程序时，如何避免在 sidebarMenu 中闪烁所有条件面板的初始加载？
【发布时间】：2022-01-06 13:03:49
【问题描述】：

在下面的代码中，我正在创建一个基于所选选项卡的动态sidebarMenu。在此应用程序的初始加载期间，即使只选择了tab 1，也会呈现两个选项卡的sidebarMenu。在我的原始应用程序中，这会导致加载时间延迟，因为我在每个选项卡上都有很多控件。

在加载应用程序时，有没有办法只加载活动选项卡的侧边栏控件，而不是加载两个选项卡的侧边栏控件？

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(
  collapsed = FALSE,
  sidebarMenu(
    id = "menu_sidebar",
    conditionalPanel(
      condition = "input.main_tab == 'tab 1'",
      selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
      print("Hello Tab 1")
    ),
    conditionalPanel(
      condition = "input.main_tab == 'tab 2'",
      selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
      print("Hello Tab 2")
    )
  )
)


body <- dashboardBody(
  fluidRow(
    tabsetPanel(
      id = "main_tab",
      selected = "tab 1",
      tabPanel(title = "tab 1", "Tab content 1"),
      tabPanel(title = "tab 2", "Tab content 2")
    )
  )
)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    sidebar,
    body
  ),
  server = function(input, output) {
  }
)

【问题讨论】：

标签： r shiny shinydashboard shiny-server shinyapps

【解决方案1】：

我们可以使用insertUI 和一个仅称为once 的observeEvent 来实现：

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(
  collapsed = FALSE,
  sidebarMenu(
    id = "menu_sidebar",
    conditionalPanel(
      condition = "input.main_tab == 'tab 1'",
      selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
      div("Hello Tab 1")
    ))
)

body <- dashboardBody(
  fluidRow(
    tabsetPanel(
      id = "main_tab",
      selected = "tab 1",
      tabPanel(title = "tab 1", "Tab content 1"),
      tabPanel(title = "tab 2", "Tab content 2")
    )
  )
)

shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    sidebar,
    body
  ),
  server = function(input, output, session) {
    observeEvent(input$main_tab == 'tab 2', {
      insertUI(
        selector = "#menu_sidebar",
        where = "afterEnd",
        ui = conditionalPanel(
          condition = "input.main_tab == 'tab 2'",
          selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
          div("Hello Tab 2")
        ),
        immediate = TRUE,
        session = getDefaultReactiveDomain()
      )
    }, ignoreInit = TRUE, once = TRUE)
  }
)

【讨论】：

非常感谢！有没有办法将observeEvent/insertUI 移动到单独的函数或文件中，这样server 函数就不会不成比例地增长？
当然可以，例如将代码包装在一个函数中，并将其放在 R/ 目录（应用程序的子目录）中的单独 *.R 文件中，以便自动获取它们。请参阅this related article 或将它们放在其他地方并在服务器功能中自己使用source。

【解决方案2】：

ismirsehregal 的另一个回答帮助我更优雅地解决了这个问题。这个想法来自之前的帖子here。

library(shiny)
library(shinydashboard)

sidebar <- dashboardSidebar(
  collapsed = FALSE,
  sidebarMenu(
    id = "menu_sidebar",
    conditionalPanel(
      condition = "input.main_tab == 'tab 1'",
      selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
      print("Hello Tab 1"),
      style = "display: none;"
    ),
    conditionalPanel(
      condition = "input.main_tab == 'tab 2'",
      selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
      print("Hello Tab 2"),
      style = "display: none;"
    )
  )
)


body <- dashboardBody(
  fluidRow(
    tabsetPanel(
      id = "main_tab",
      selected = "tab 1",
      tabPanel(title = "tab 1", "Tab content 1"),
      tabPanel(title = "tab 2", "Tab content 2")
    )
  )
)


shinyApp(
  ui = dashboardPage(
    dashboardHeader(title = "tabBoxes"),
    sidebar,
    body
  ),
  server = function(input, output) {
  }
)

【讨论】：