R Shiny : How can I make multiple elements reactive in add/remove button context?

Question

我正在创建一个 Shiny 的应用程序，这样当我单击添加或删除按钮时，多个 react 元素会受到影响。我已经大大简化了我在下面尝试做的事情。基本上，我们并排得到 selectInput() 和 textInput() 框，这样 textInput() 框就填充了用户选择的 selectInput() 框的结果。然后我有一个添加按钮和删除按钮，这样通过单击添加按钮，在下一行，我们并排获得新的 selectInput() 和 textInput() 框。如上，新行的 textInput() 框显示新行的 selectInput() 框的用户选择结果。

我遇到的问题是能够引用新的 seletInput() 框的新值。使用 get() 引用不起作用，我需要一种迭代方式来在添加和删除新框时引用这些值。如何成功调用对连续 selectInput() 框结果的引用？

suppressWarnings(library(shiny))
suppressWarnings(library(shinyFiles))


ui <- function(request) {
    fluidPage(
        fluidRow(
            column(2,
                uiOutput("ui1")
            ),
            column(2,
                uiOutput("ui2")
            ),
            column(1,
                actionButton(inputId = 'insertParamBtn', label = "Add Param")
            ),
            column(1,
                actionButton(inputId = 'removeParamBtn', label = "Remove Param")
            )
            ),
        tags$div(id = 'placeholder'),
        hr(),
        fluidRow(column(12, verbatimTextOutput("view", placeholder = T)))
            )
}

server <- function(input, output, session) {
    params <- reactiveValues(btn = 0)
    output$ui1 <- renderUI({
        selectInput("UI1", "First UI",
            choices = thisList, selected = 1)
    })
    output$ui2 <- renderUI({
        textInput("UI2", "Second UI", value = input$UI1, width = '150px')
    })

    observeEvent(input$insertParamBtn, {
        params$btn <- params$btn + 1
        insertUI(
            selector = '#placeholder',
        ## wrap element in a div with id for ease of removal
            ui = tags$div(
                id = paste0('param', params$btn + 1),
                    tags$p(fluidRow(
                        column(2,
                            selectInput(paste0("UI1", params$btn + 1),
                                        paste0("First UI ", params$btn + 1),
                                        choices = thisList, selected = 1)
                                ),
                        column(2,
                            textInput(paste0("UI2", params$btn + 1),  #*#
                                paste0("Second UI ", params$btn + 1),  #*#
                                value = get(paste0("input$UI1", params$btn + 1)),  #*#
                                    width = '150px')    #*#
                                )
                                )
                            )
                            )
                            )
    output$view <- renderPrint({ get(paste0("UI1", params$btn + 1)) })
    })

    observeEvent(input$removeParamBtn, {
    removeUI(
    ## pass in appropriate div id
            selector = paste0('#param', params$btn + 1)
                )
    params$btn <- params$btn - 1
    })

    }
    shinyApp(ui = ui, server = server)

Answer 1

我不确定这是否是您想要的，但以下方法通过两个按钮添加/删除输入对。首先，我创建了一个 shiny module对于选择二人组

thisList <- as.list(c(1, 2, 3, 4, 5), c(1, 2, 3, 4, 5)) 

suppressWarnings(library(shiny))

selectorUI <- function(id){
  ns = NS(id)

  tags$div(
    fluidRow(
      column(6, uiOutput(ns('first'))),
      column(6, uiOutput(ns('second')))
    ),
    id = paste0('param', id)
  )
}

selectorServer <- function(input, output, session){
  ns = session$ns

  output$first <- renderUI({
    selectInput(
      ns('first'),
      ns("First UI"),
      choices = thisList, selected = 1)
  })

  output$second <- renderUI({
    textInput(
      ns('second'),
      ns("Second UI"),
      value = input$first)
  })
}

新的 ui 已经使用 selectorUI :模块的ui端功能。

ui <- fluidPage(
  selectorUI(0),
  fluidRow(
    column(6, actionButton(inputId = 'insertParamBtn', label = "Add Param")),
    column(6, actionButton(inputId = 'removeParamBtn', label = "Remove Param"))
  ),
  tags$div(id = 'placeholder'),
  hr(),
  fluidRow(column(12, verbatimTextOutput("view", placeholder = T)))
)

服务器端为 id=0 渲染模块在启动时和 id=params$button每当添加新行时。

server <- function(input, output, session) {
  callModule(selectorServer, 0)

  params <- reactiveValues(btn = 0)

  output$view <- renderPrint({ 
    print(input[[NS(params$btn, "first")]])
    print(input[[NS(params$btn, "second")]])
  })

  observeEvent(input$insertParamBtn, {
    params$btn <- params$btn + 1
    callModule(selectorServer, params$btn)
    insertUI(
      selector = '#placeholder',
      ui = selectorUI(params$btn)
    )
  })

  observeEvent(input$removeParamBtn, {
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#param', params$btn)
    )
    params$btn <- params$btn - 1
  })      
}
shinyApp(ui = ui, server = server)

您的代码的主要区别在于我使用了两个单独的 renderUI调用 selectInput和 textInput .将这两者合二为一 renderUI如果您不小心， call 可能会创建无限循环。

我使用模型重写了这一事实只是一个设计决策，它使代码更易于阅读和扩展 IMO。