首页 > 解决方案 > 如何为动态添加的模块添加书签和恢复?

问题描述

我正在尝试保存和恢复使用动态呈现 UI 输出的模块的应用程序。

我希望书签功能可以与该应用程序一起使用,我添加bookmarkButton并启用了书签enableBookmarking = "server"。我还使 ui 成为一个函数。我了解到书签可以与 modules 一起使用,但我无法找到一种方法让它与动态创建的 UI 输入和输出一起工作。仅恢复最后的输入和输出。其他没有恢复。

示例应用程序:

library(shiny)

histogramUI <- function(id) {
  tagList(
    fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
    numericInput(NS(id, "bins"), "bins", value = 10, min = 1)),
    column(8, plotOutput(NS(id, "hist"))))
  )
}


histogramServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    data <- reactive(mtcars[[input$var]])
    output$hist <- renderPlot({
      hist(data(), breaks = input$bins, main = input$var)
    }, res = 96)
  })
}

ui <- function(request){
  fluidPage(
    bookmarkButton(),
    actionButton("add", "Add"),
    div(id = "add_here")
    )
  }

server <- function(input, output, session) {
  
  
  observeEvent(input$add, {
    histogramServer(paste0("hist_", input$add))
    insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add)))
  })
  
  
}

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

仅恢复最后一个输入和绘图输出:

在此处输入图像描述

标签: rshiny

解决方案


另一种方法:

library(shiny); library(purrr)

histogramUI <- function(id) {
    ns <- NS(id)
    tagList(
        fluidRow(column( 4, selectInput(ns("var"), "Variable", choices = names(mtcars)),
                         numericInput(ns("bins"), "bins", value = 10, min = 1)),
                 column(8, plotOutput(ns("hist"))))
    )
}

histogramServer <- function(id) {
    moduleServer(id, function(input, output, session) {
        vals <- reactiveValuesToList(input)
        
        data <- reactive(mtcars[[input$var]])
        output$hist <- renderPlot({
            hist(data(), breaks = input$bins, main = input$var)
        }, res = 96)
        
        #to avoid inputs resetting after adding another.
        if(length(vals) != 0) {
            updateSelectInput(session, 'var', "Variable", choices = names(mtcars), selected = vals$var)
            updateNumericInput(session, 'bins', "bins", value = input$bins, min = 1,)
        } 
    })
}

ui <- function(request){
    fluidPage(
        bookmarkButton(),
        actionButton("add", "Add"),
        uiOutput('histogram_module') 
    )
}

server <- function(input, output, session) {
    
    observeEvent(input$add, {
        #the server module
        map(1:input$add, ~histogramServer(paste0("hist_", .x)))
        #the ui module
        output$histogram_module <- renderUI({ map(1:input$add, ~histogramUI(id = paste0("hist_", .x))) })
    })
}

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

推荐阅读