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)
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With