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

我正在创建一个 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)

最佳答案

我不确定这是否是您想要的，但是以下方法通过两个Buttrons添加/删除输入对。首先，我为selection-duo创建了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)
  })
}

新的用户界面已经使用selectorUI:模块的用户界面功能。

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调用中会创建无限循环。

我使用模型重新编写代码的事实只是设计决策，使代码更易于阅读和扩展IMO。