生成新的选择器而不清除Shiny中的输入

Question

我有一个

Shiny

应用程序，其中

n

pickerInputs

由用户生成。如果用户先生成

Inputs

然后再制作

Choices

，则效果很好。但是，如果用户生成一个

Input

，制作一个

Choice

，然后决定生成另一个

Input

，则

Choices

将被恢复。

解决此问题的一种方法是使用

generate_pickers_fun

扩展函数

selected

。当

Picker selection

发生变化时，函数会在创建选择器时获取

Selections

。我已将此作为解决方案发布。

问题是，每次选择生成一个新的

Picker

时，所有先前的

Pickers

都会重新运行。有没有办法只更新而不重新运行？

library(shiny)
library(shinyWidgets)
library(tidyverse)

generate_pickers_fun <- function(picker_name, id){
  
  picker <-   pickerInput(
    inputId = NS(id, picker_name),
    label = picker_name,
    multiple = TRUE,
    choices = LETTERS[1:5]
  )
  
  return(picker)
  
}

ui_mod <- function(id) {
  ns <- NS(id)
  tagList(
    
    pickerInput(NS(id, "generate_pickers"), choices = c("Picker_1", "Picker_2", "Picker_3", "Picker_4"), multiple = TRUE),
    uiOutput(NS(id, "new_pickers"))
  )
}

server_mod <- function(id) {
  moduleServer(id, function(input, output, session) {
    
    reactive_values <- reactiveValues()
    
    observeEvent(input$generate_pickers, {
      
      req(input$generate_pickers)
        
      
      new_pickers <- map(input$generate_pickers, generate_pickers_fun, id = id)
      output$new_pickers <- renderUI(tagList(new_pickers))
      
    }, ignoreNULL = FALSE)
    
  })
}

app <- function() {
  ui <- fluidPage(
    ui_mod("test")
  )
  server <- function(input, output, session) {
    server_mod("test")
  }
  shinyApp(ui, server)  
}

app()

Answer 1

在下面的解决方案中，我扩展了生成选择器以包含所选内容的函数。我还使用

reactiveValues

来存储选择。

library(shiny)
library(shinyWidgets)
library(tidyverse)

generate_pickers_fun <- function(picker_name, selected = c(), id){
  
  picker <-   pickerInput(
    inputId = NS(id, picker_name),
    label = picker_name,
    multiple = TRUE,
    selected = selected,
    choices = LETTERS[1:5]
  )
  
  return(picker)
  
}

ui_mod <- function(id) {
  ns <- NS(id)
  tagList(
    
    pickerInput(NS(id, "generate_pickers"), choices = c("Picker_1", "Picker_2", "Picker_3", "Picker_4"), multiple = TRUE),
    uiOutput(NS(id, "new_pickers"))
  )
}

server_mod <- function(id) {
  moduleServer(id, function(input, output, session) {
    
    reactive_values <- reactiveValues()
    reactive_values$current_pickers <- c()
    
    observeEvent(input$generate_pickers, {
      
      req(input$generate_pickers)
      
      current_choices <- map(input$generate_pickers, ~input[[.x]])
      
      new_pickers <- map2(input$generate_pickers,current_choices, ~generate_pickers_fun(.x, .y, id = id))
      output$new_pickers <- renderUI(tagList(new_pickers))
      
      reactive_values$current_pickers <- input$generate_pickers
      
    }, ignoreNULL = FALSE)
    
  })
}

app <- function() {
  ui <- fluidPage(
    ui_mod("test")
  )
  server <- function(input, output, session) {
    server_mod("test")
  }
  shinyApp(ui, server)  
}

app()