基于R6与call modules实现observe事件下Shiny页面动态切换

方案1：基于shinyjs实现（改造成本最低） #

完全可以用shinyjs实现，只需要给两个页面的UI外层增加独立标识容器，控制显示隐藏即可，修改步骤如下： #

第一步：修改Page1类 #

1. UI层引入shinyjs，外层加唯一容器ID
2. 按钮点击逻辑增加counter=4时的页面切换判断
3. 暴露私有ID给Page2调用（解决Page2初始化拿不到ID的问题）
   修改后的Page1完整代码：

page1 <- R6::R6Class(classname = "Page1",
            private = list(
              #unique string id
              ..id = stringi::stri_rand_strings(1, 18),
              #the data to be iterated through
              ..df = df,
              #counter to uqpdate text
              ..counter = 1,
              #initiating the dp and desc
              ..dp = NA,
              ..desc = NA,
              
              #the underlying server, to be created like a normal server
              .server = function(input, output, session){
                
                output$text <- renderText({ 
                  self$desc$text
                })
                
                observeEvent(input$button, {
                  private$..counter <- private$..counter + 1
                  # 新增页面切换逻辑
                  if(private$..counter == 4){
                    shinyjs::hide("page1_container")
                    shinyjs::show("page2_container")
                  }
                  
                  self$update_private()
                  self$desc$text <- private$..desc
                  #check the private content since the print is not updating
                  print(private$..counter)
                  print(private$..dp)
                  print(private$..desc)
                })
              }
            ),
            active = list(
              .counter = function(value){
                if(missing(value)){
                  private$..counter
                }else{
                  private$..counter <- value
                }
              },
              # 新增：暴露私有ID给外部调用
              .id = function(){
                private$..id
              }
            ),
            public = list(
              #create names for ui elements
              button = NULL,
              text = NULL,
              
              
              #Need this to update the text***************
              desc = reactiveValues(text = NA),
              
              initialize = function(counter = self$.counter){
                self$.counter <- counter
                self$button <- self$get_id("button")
                self$text <- self$get_id("text")
                self$update_private()
                self$desc$text <- private$..desc
              },
              
              #gives ui outputs unique names tied to the user's id
              get_id = function(name, ns = NS(NULL)){
                ns <- NS(ns(private$..id))
                id <- ns(name)
                return(id)
              },
              #automatically updates the private field based on the counter
              update_private = function(){
                if(private$..counter == 1){
                  private$..dp <- "dp1"
                } else if(private$..counter == 2){
                  private$..dp <- "dp2"
                } else{
                  private$..dp <- "dp3"
                }
                private$..desc <- private$..df[private$..df$dp == private$..dp, "desc"]
              },
              
              ui = function(){
                div(id = "page1_container",
                  fluidPage(
                    # 引入shinyjs依赖
                    shinyjs::useShinyjs(),
                    h1("An Example"),
                    mainPanel(
                    textOutput(self$text)),
                    sidebarPanel(
                    shiny::actionButton(inputId = self$button, 
                                        label = 'Update!', 
                                        width = '100%'
                    ))
                  )
                )
              },#end ui
              
              server = function(input, output, session){
                counter <- reactiveVal(private$..counter)
                callModule(module = private$.server, id = private$..id)
              }
            )
)

第二步：修改Page2类 #

UI层加初始隐藏的容器，初始化时调用Page1暴露的ID：

page2 <- R6::R6Class(classname = "Page2",
                     private = list(
                       ..init = NULL,
                       #unique string id
                       ..id = NULL,
                      
                       #the underlying server, to be created like a normal server
                       .server = function(input, output, session){
                         
                       }
                     ),
                     active = list(
                       .init = function(value){
                         if(missing(value)){
                           message("init class object required")
                         }else{
                           private$..init <- value
                         }
                       }
                       
                     ),
                     public = list(
                       initialize = function(init = self$.init){
                         self$.init <- init
                         # 调用Page1暴露的.id访问器
                         private$..id <- private$..init$.id
                         
                       },
                       
                       #gives ui outputs unique names tied to the user's id
                       get_id = function(name, ns = NS(NULL)){
                         ns <- NS(ns(private$..id))
                         id <- ns(name)
                         return(id)
                       },
                       
                       ui = function(){
                         # 初始状态隐藏
                         shinyjs::hidden(
                           div(id = "page2_container",
                             fluidPage(
                               h1("An Example Connection"),
                               mainPanel(
                                 "Thanks for participating!")
                             )
                           )
                         )
                       },#end ui
                       
                       server = function(input, output, session){
                         callModule(module = private$.server, id = private$..id)
                       }
                     )
)

第三步：修改主App代码 #

主UI同时加载两个页面的UI即可：

app1 <- page1$new()
app2 <- page2$new(init = app1)

ui <- fluidPage(
  app1$ui(),
  app2$ui()
)

server <- function(input, output, session) {
  app1$server()
  app2$server()
}
shinyApp(ui = ui, server = server)

方案2：原生Shiny实现（无需依赖shinyjs） #

如果不想引入额外依赖，可以用conditionalPanel或者renderUI动态渲染页面，适合后续需要更复杂页面路由的场景，核心逻辑：

• 在Page1的public中新增响应式触发器page_trigger = reactiveVal(1)
• 按钮点击counter到4时更新page_trigger(2)
• 主UI用conditionalPanel根据触发器数值切换显示对应页面
• 主服务端把触发器暴露为output变量即可

内容的提问来源于stack exchange，提问作者mauraeh