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

问题

I am creating a shiny app such that when I click on add or remove button, multiple reactive elements are affected. I have simplified significantly what I am trying to do below. Basically, we get selectInput() and textInput() boxes side-by-side, such that the textInput() box is populated with the user-chosen result of selectInput() box. I then have an add button and remove button, such that by clicking the add button, on the next line down, we get new selectInput() and textInput() boxes side-by-side. As above, the new row's textInput() box displays the user-chosen result of the new row's selectInput() box.

The issue I am having is being able to reference the new value of the new seletInput() box. Using a get() reference does not work, and I need an iterative way to be able to reference these values as new boxes are added and removed. How can I successfully call references to the result of successive selectInput() boxes?

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)

回答1:

I am not sure if this is what you want, but the following approach adds/removes input pairs via two buttrons. First, I created a shiny module for the selection-duo

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)
  })
}

The new ui already uses selectorUI: the ui side function of the module.

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)))
)

The server side renders the module for id=0 at startup and for id=params$button whenever a new row is added.

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)

The key difference to your code is that I used two seperate renderUI calls for the selectInput and the textInput. Putting those two in one single renderUI call can create infinite loops if you are not careful.

The fact that I rewrote this using models is just a design decision that makes the code easier to read and extend IMO.

来源：https://stackoverflow.com/questions/46529961/r-shiny-how-can-i-make-multiple-elements-reactive-in-add-remove-button-context