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

元气小坏坏 提交于 2021-02-08 15:19:28

问题


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

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!