r - 具有相互依赖的动态输入的闪亮书签

Question

我正在尝试恢复一个带有书签的闪亮应用程序，该应用程序根据来自另一个输入的选择插入一组不同的输入，并且插入的输入集相互依赖。（复杂，我知道！但不要去。）

这是一个应用程序的最小可重现示例，我无法弄清楚如何正确恢复所有输入 - 即，依赖于 s1 的输入 s2 无法恢复。

（我知道onRestore()&onRestored()函数调用中的代码只能用于恢复第一个插入的 UI。我这样做是为了更容易理解问题。）

library(shiny)

mod_insert_slide_ui <- function(id) {
  ns <- NS(id)
  tagList(
    div(id = ns("div"),
        selectInput(ns("type"), "Choose Type", c("", "a", "b")))
  )
}

mod_insert_slide_server <- function(id) {
  moduleServer(
    id, 
    function(input, output, session) {
      ns <- session$ns
      observeEvent(input$type, ignoreInit = TRUE, ignoreNULL = TRUE, {
        removeUI(
          selector = paste0("#", ns("inserted_ui"))
        )
        insertUI(
          selector = paste0("#", ns("div")),
          where = "beforeEnd",
          ui = tags$div(
            id = ns("inserted_ui"),
            switch(
              input$type,
              "a" =  list(
                h1("This is type a"),
                selectizeInput(
                  ns("s1"),
                  "s1",
                  c("a", "b", "c"),
                  selected = character(0),
                  multiple = TRUE
                ),
                selectizeInput(ns("s2"), "s2", character(0), multiple = TRUE)
              ),
              "b" = list(
                h1("This is type b"),
                selectizeInput(
                  ns("s1"),
                  "s1",
                  c("a", "b", "c"),
                  selected = character(0),
                  multiple = TRUE
                ),
                selectizeInput(ns("s2"), "s2", character(0), multiple = TRUE)
              )
            )
          )
        )
      })
       
        
        observeEvent(input$s1, ignoreNULL = TRUE, ignoreInit = TRUE, {

          if (!is.null(input$s1))
            choices <- input$s1
          else
            choices <- character(0)
          updateSelectizeInput(
            session,
            "s2",
            choices = choices,
            selected = input$s2,
            server = TRUE
          )
        })
    }
  )
}

ui = function(request) {
  fluidPage(
    bookmarkButton(),
    actionButton("add", "add"),
    div(
      id = "div_id"
    )
  )
}

server = function(input, output, session) {
  
  onRestore(function(state) {
    insertUI("#add", "afterEnd", mod_insert_slide_ui("div_id1"))
    mod_insert_slide_server("div_id1")
  
  })
  
  onRestored(function(state) {
    s1 <- state$input$`div_id1-s1`
    s2 <- state$input$`div_id1-s2`
    # updateSelectizeInput(session, "div_id1-s1", selected = s1, choices = letters, server = TRUE)
    updateSelectizeInput(session, "div_id1-s2", choices = s1, selected = s2, server = TRUE)
  })
  
  observeEvent(input$add, ignoreInit = TRUE, ignoreNULL = TRUE, {
    insertUI("#div_id", "afterBegin", mod_insert_slide_ui(paste0("div_id", input$add)))
    mod_insert_slide_server(paste0("div_id", input$add))
  })
  
}

shinyApp(ui = ui, server = server, enableBookmarking = "url")

这是同一个应用程序，但没有使插入的 UI 有条件的“类型”输入。书签现在按预期工作。

library(shiny)

mod_insert_slide_ui <- function(id) {
  ns <- NS(id)
  tagList(
    div(
      id = ns("div")
    )
  )
}

mod_insert_slide_server <- function(id) {
  moduleServer(
    id, 
    function(input, output, session) {
      ns <- session$ns
        removeUI(
          selector = paste0("#", ns("inserted_ui"))
        )
        insertUI(
          selector = paste0("#", ns("div")),
          where = "beforeEnd",
          ui = tags$div(
            id = ns("inserted_ui"),
            list(
                selectizeInput(
                  ns("s1"),
                  "s1",
                  c("a", "b", "c"),
                  selected = character(0),
                  multiple = TRUE
                ),
                selectizeInput(ns("s2"), "s2", character(0), multiple = TRUE)
            )
          )
        )
      
      
      observeEvent(input$s1, ignoreNULL = TRUE, ignoreInit = TRUE, {
        if (!is.null(input$s1))
          choices <- input$s1
        else
          choices <- character(0)
        updateSelectizeInput(
          session,
          "s2",
          choices = choices,
          selected = input$s2,
          server = TRUE
        )
      })
    }
  )
}

ui = function(request) {
  fluidPage(
    bookmarkButton(),
    actionButton("add", "add"),
    div(
      id = "div_id"
    )
  )
}

server = function(input, output, session) {
  
  onRestore(function(state) {
    insertUI("#add", "afterEnd", mod_insert_slide_ui("div_id1"))
    mod_insert_slide_server("div_id1")
    
  })
  
  onRestored(function(state) {
    s1 <- state$input$`div_id1-s1`
    s2 <- state$input$`div_id1-s2`
    # updateSelectizeInput(session, "div_id1-s1", selected = s1, choices = letters, server = TRUE)
    updateSelectizeInput(session, "div_id1-s2", choices = s1, selected = s2, server = TRUE)
  })
  
  observeEvent(input$add, ignoreInit = TRUE, ignoreNULL = TRUE, {
    insertUI("#div_id", "afterBegin", mod_insert_slide_ui(paste0("div_id", input$add)))
    mod_insert_slide_server(paste0("div_id", input$add))
  })
  
}

shinyApp(ui = ui, server = server, enableBookmarking = "url")

那么为什么第二个例子有效，而第一个无效呢？如何让书签与“类型”输入引入的条件一起工作？

编辑：

手动将值作为响应传递给服务器模块似乎可行。但这是推荐的方法吗？

library(shiny)

mod_insert_slide_ui <- function(id) {
  ns <- NS(id)
  tagList(
    div(
      id = ns("div"),
        selectInput(ns("type"), "Choose Type", c("", "a", "b"))
    )
  )
}

mod_insert_slide_server <- function(id, is_restored, s2_val) {
  moduleServer(
    id, 
    function(input, output, session) {
      ns <- session$ns
      observeEvent(input$type, ignoreInit = TRUE, ignoreNULL = TRUE, {
        removeUI(
          selector = paste0("#", ns("inserted_ui"))
        )
        insertUI(
          selector = paste0("#", ns("div")),
          where = "beforeEnd",
          ui = tags$div(
            id = ns("inserted_ui"),
            switch(
              input$type,
              "a" =  list(
                h1("This is type a"),
                selectizeInput(
                  ns("s1"),
                  "s1",
                  c("a", "b", "c"),
                  selected = character(0),
                  multiple = TRUE
                ),
                selectizeInput(ns("s2"), "s2", character(0), multiple = TRUE)
              ),
              "b" = list(
                h1("This is type b"),
                selectizeInput(
                  ns("s1"),
                  "s1",
                  c("a", "b", "c"),
                  selected = character(0),
                  multiple = TRUE
                ),
                selectizeInput(ns("s2"), "s2", character(0), multiple = TRUE)
              )
            )
          )
        )
      })
       
        
        observeEvent(input$s1, ignoreNULL = TRUE, ignoreInit = TRUE, {
          
          if (!is.null(input$s1))
            choices <- input$s1
          else
            choices <- character(0)
          if (!is_restored()) {
            updateSelectizeInput(
              session,
              "s2",
              choices = choices,
              selected = input$s2,
              server = TRUE
            )            
          } else {
            updateSelectizeInput(
              session,
              "s2",
              choices = choices,
              selected = s2_val(),
              server = TRUE
            )            
          }
        })
    }
  )
}

ui = function(request) {
  fluidPage(
    bookmarkButton(),
    actionButton("add", "add"),
    div(
      id = "div_id"
    )
  )
}

server = function(input, output, session) {
  is_restored <- reactiveVal(F)
  s2_val <- reactiveVal(NULL)
  onRestore(function(state) {
    insertUI("#add", "afterEnd", mod_insert_slide_ui("div_id1"))
    mod_insert_slide_server("div_id1", is_restored = is_restored, s2_val = s2_val)
  
  })
  
  onRestored(function(state) {
    
    #s1 <- state$input$`div_id1-s1`
    s2 <- state$input$`div_id1-s2`
    # updateSelectizeInput(session, "div_id1-s1", selected = s1, choices = letters, server = TRUE)
    # updateSelectizeInput(session, "div_id1-s2", choices = s1, selected = s2, server = TRUE)
    is_restored(T)
    s2_val(s2)
  })
  
  observeEvent(input$add, ignoreInit = TRUE, ignoreNULL = TRUE, {
    insertUI("#div_id", "afterBegin", mod_insert_slide_ui(paste0("div_id", input$add)))
    mod_insert_slide_server(paste0("div_id", input$add), is_restored = is_restored, s2_val = s2_val)
  })
  
  
}

shinyApp(ui = ui, server = server, enableBookmarking = "url")

标签： rshinyshiny-reactivity