模块化Shiny应用中accordion panels的书签恢复问题

目标 #

在Shiny应用中动态生成若干accordion面板，应用需支持书签功能，在页面刷新（如断开重连）时恢复这些面板及其内容。

问题 #

在简单版Shiny应用中，所有accordion面板及其值均可成功恢复，但在模块化应用中，仅最后一个面板能被恢复，不清楚代码中缺失了什么。

代码 #

mod_form_ui <- function(id) {
  ns <- NS(id)
  tagList(
    uiOutput(ns("event_form"))
  )
}

mod_form_server <- function(id, event_name, Day) {


  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      # 基于日期生成事件名称
      sim_event <- reactive(paste0("event_", gsub("\\s", "", event_name), "_", Day))

      output$event_form <- renderUI({

        tagList(
          textAreaInput(
            inputId = ns(paste0(sim_event(), "_eventStart")),
            label = "Event Start",
            placeholder = "Event started at ..."
          )
        )

      })

    }
  )
}



mod_all_events_ui <- function(id) {
  ns <- NS(id)
  tagList(
    actionButton(ns("add"), "New Event"),
    br(),
    accordion(
      id = ns("accord_all_events")
    )
  )
}

mod_all_events_server <- function(id, Day) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      # 点击"新建事件"按钮弹出模态框输入事件名称
      observeEvent(input$add, {

          showModal(
            modalDialog(
              tagList(
                textInput(
                  inputId = ns("event_name"),
                  label = "Event name:",
                  value = ""
                ),
                # 提交按钮
                actionButton(ns("create_event"), "Submit")
              ),
              title = "New Event",
              footer = modalButton("Dismiss")
            )
          )

      })

      # 存储事件名称的响应式变量
      events <- reactiveVal(character(0))

      # 点击提交按钮后，在accordion中插入新的表单面板
      observeEvent(input$create_event, {

        req(input$event_name)

        removeModal()

        new_event_name <- isolate(input$event_name)

        form_id <- paste0(gsub("\\s", "", new_event_name), "_form")

        accordion_panel_insert(id = "accord_all_events",
                               panel = accordion_panel(title = new_event_name,
                                                       mod_form_ui(ns(form_id))))

        accordion_panel_close(id = "accord_all_events", values = TRUE)


        mod_form_server(form_id, new_event_name, Day)

        # 更新响应式变量，添加新事件信息
        events(c(events(), list(name = new_event_name, id = form_id)))

      })



      onBookmark(function(state) {
        state$values$Events <- events()
      })

      onRestore(function(state) {
        for(event in head(state$values$Events, -1)) {
          form_id <- event$id
          accordion_panel_insert(
            id = "accord_all_events",
            panel = accordion_panel(
              title = event$name,
              mod_form_ui(ns(form_id))
            )
          )

          mod_form_server(form_id, event$name, Day)
        }
      })

    }
  )
}


create_day_page <- function(x) {
  number <- as.numeric(gsub("[^0-9]", "", x))
  navset_card_pill(
    id = paste0("pill_", number),
    nav_panel(
      title = "All Events",
      mod_all_events_ui(paste0("all_events_", number))
    )
  )
}



library(shiny)
library(bslib)

# 主UI
ui <- function(request) {
  page_navbar(

  title = "CI",

  sidebar = sidebar(
    selectizeInput(
      inputId = "day",
      label = HTML("Select Day: <span style='color:red'>*</span>"),
      choices = c("Day1", "Day2", "Day3", "Day4", "Day5", "Day6", "Day7"),
      options = list(
        placeholder = 'Select day',
        onInitialize = I('function() { this.setValue(""); }')
      )
    )
  ),

  conditionalPanel(
    condition = "input.day !== ''",
    shiny::uiOutput("day_page")
  ),

  nav_item(
    uiOutput("sign_out_button")
  )
)
}

# 主Server

server <- function(input, output, session) {

    # 监听日期选择，生成对应页面UI
  observe({
    # 检查是否选择了日期
    if (!is.null(input$day) && input$day != "") {
      # 渲染日期页面
      output$day_page <- renderUI({
        tagList(
          h4(gsub("Day(\\d+)", "Day \\1", input$day)),
          create_day_page(input$day)
        )
      })


      # 初始化"所有事件"模块服务端
      number <- as.numeric(gsub("[^0-9]", "", input$day))
      Day <- paste0("Day", number)
      mod_all_events_server(id = paste0("all_events_", number), input$day)
    }
  })

  # 自动保存书签
  observe({
    reactiveValuesToList(input)
    session$doBookmark()
  })
  onBookmarked(updateQueryString)
}


shinyApp(ui, server)

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