R Shiny：如何使多个元素在添加/删除按钮上下文中具有反应性？

Posted 2023-03-24

【中文标题】R Shiny：如何使多个元素在添加/删除按钮上下文中具有反应性？

【英文标题】：R Shiny: How can I make multiple elements reactive in add/remove button context?

【发布时间】：2018-03-13 18:53:29

【问题描述】：

我正在创建一个闪亮的应用程序，当我单击添加或删除按钮时，多个反应元素会受到影响。我已经大大简化了我在下面尝试做的事情。基本上，我们并排得到 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)

【问题讨论】：

您的代码似乎有问题。对象thislist 未定义，但在应用程序中使用了两次。

thisList

对不起，忘了先复制那行。感谢提醒

【参考方案1】：

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

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

您的代码的主要区别在于我对selectInput 和textInput 使用了两个单独的renderUI 调用。如果您不小心，将这两个放在一个 renderUI 调用中可能会造成无限循环。

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