Rupayan Neogy Rupayan Neogy - 3 years ago 91
R Question

Dynamic Creation of Reactive UI Inputs and Buttons in Shiny

I want to be able to dynamically add UI inputs, use the input values, and have actions associated with dynamically added UI Buttons.

The closest solution I can find is this stackoverflow question, which does handle the first two things I need. However, I can't figure out how to associate reactive actions with the click actions of dynamically added buttons.

The simplest use case would be something that is often seen on plenty of modern websites (and would be easy to implement outside Shiny using HTML/CSS/JS):

There is a row of inputs, and a button below that says "add." When you click the add button, another row is added, along with a button at the end of that row that allows you to delete that row. In this way, you can add another row at the bottom of the list by clicking the add button, or remove any of the rows shown by clicking on the delete button in that row.

As demonstrated in the stackoverflow link above, it is possible to add rows using a button outside of the dynamically rendered UI. You can just as easily remove rows by adding a similar button outside of the dynamically rendered UI, but this only allows you to remove the last row (or some hardcoded row number). What I'd like is to have dynamically rendered buttons on each row that, when clicked, remove the row.

The main problem I've been having is that, given each row has an ID number 1, 2, 3, etc, then each button might have an id "remove1", "remove2", "remove3", etc. However, as far as I can tell, I can't create a generic observeEvent for an ID that might have variable values:

observeEvent(input$removei,{
# remove row i
})


Of course, I would like to be more generic - the button doesn't necessarily have to remove the row, I might also want it to open a modal/another panel that displays data relevant to that row.

Can anyone give any insight on how one might do this? Thanks in advance!

EDIT: A code snippet (modified from the above stackoverflow link) that demonstrates what I want. Ideally, I'd like to be able to click on the "x" button and remove the row it is associated with.

library(shiny)

ui <- shinyUI(pageWithSidebar(
headerPanel("Add Features"),
sidebarPanel(width=4,
fluidRow(column(12,
h3('Features'),
uiOutput('uiOutpt')
)), # END fluidRow
fluidRow(
column(4,div()),
column(4,actionButton("add", "Add!")),
column(4,actionButton('goButton',"Analyze"))
) # END fluidRow
), # END sidebarPanel
mainPanel(
verbatimTextOutput("nText"),
textOutput("text2"),
tableOutput('tbl')
)
))

server <- shinyServer(function(input, output) {
features <- reactiveValues(renderd=c(1))

ntext <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
vn <- paste0('Feature',i)
# Get input values by namw
sprintf( 'Variable: %s',input[[vn]] )
})
do.call(paste,c(out,sep="\n"))
})

df <- eventReactive(input$goButton, {
out <- lapply(features$renderd,function(i){
vn <- paste0('Feature',i)
data.frame(Variable=input[[vn]] )
})
do.call(rbind,out)
})

output$nText <- renderText({
ntext()
})
output$text2 <- renderText({
sprintf("You have selected feature: %s",
paste(features$renderd,collapse=", "))
})

output$tbl <- renderTable({
df()
})

# Increment reactive values used to store how may rows we have rendered
observeEvent(input$add,{
if (max(features$renderd) > 2) return(NULL)
features$renderd <- c(features$renderd, max(features$renderd)+1)
})

# If reactive vector updated we render the UI again
observe({
output$uiOutpt <- renderUI({
# Create rows
rows <- lapply(features$renderd,function(i){
fluidRow(
selectInput(paste0('Feature',i),
label = "",
choices =
list("Feature1","Feature2","Feature3"),
selected = paste0('Feature',i)),
actionButton(paste0('remove',i), label="x")
)
})
do.call(shiny::tagList,rows)

})
})
})

shinyApp(ui=ui,server=server)

Answer Source

I figured out a decent solution using Shiny Modules for this problem. It allows you to add rows with the press of a button, and remove arbitrary rows at your choice. The one issue is the given "id" of the rows for now is simply incremented on and on to make sure that each "id" is unique. If anyone has a better way to do this, please let me know. Thanks!

library(shiny)

rowInput <- function(id){
  ns <- NS(id)
  fluidRow(
    selectInput(ns(id), 
                label = "", 
                choices = list("Feature1","Feature2","Feature3")),
    conditionalPanel('!output.bool', actionButton(ns('remove'), label="x"))
  )
} 

row <- function(input, output, session, features, id){
  observeEvent(input$remove, {
    if(length(features$renderd) < 2){
      print(features$renderd)
      return()
    }
    features$renderd <- features$renderd[features$renderd != id]
  })
}

ui <- shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
               fluidRow(column(12,
                               h3('Features'),
                               uiOutput('uiOutpt')
               )), # END fluidRow
               fluidRow(
                 column(4,div()),
                 column(4,actionButton("add", "Add!")),
                 column(4,actionButton('goButton',"Analyze"))
               ) # END fluidRow
  ), # END sidebarPanel
  mainPanel(
    verbatimTextOutput("nText"),
    textOutput("text2"),
    tableOutput('tbl'),
    textOutput("bool")
  )
))

server <- shinyServer(function(input, output) {
  features <- reactiveValues(renderd=c(1))

  nextId <- 2
  minModuleCalled <- 0

  output$bool <- reactive({
    length(features$renderd) == 1
  })

  ntext <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      # Get input values by namw
      sprintf( 'Variable: %s',input[[vn]] )
    })
    do.call(paste,c(out,sep="\n"))
  })

  df <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      vn <- paste0('Feature',i)
      data.frame(Variable=input[[vn]] )
    })
    do.call(rbind,out)
  })

  output$nText <- renderText({
    ntext()
  })
  output$text2 <- renderText({ 
    sprintf("You have selected feature: %s", 
paste(features$renderd,collapse=", "))
  })

  output$tbl <- renderTable({
    df()
  })

  # Increment reactive values used to store how may rows we have rendered
  observeEvent(input$add,{
    features$renderd <- c(features$renderd, nextId)
    nextId <<- nextId + 1
  })

  # If reactive vector updated we render the UI again
  observe({
    output$uiOutpt <- renderUI({
      # Create rows
      rows <- lapply(features$renderd, function(i){
        rowInput(paste0("Feature",i))
      })
      lapply(features$renderd, function(i){
        if(i > minModuleCalled){
          print(paste("new module",i))
          callModule(row, paste0("Feature",i), features, i)
          minModuleCalled <<- i
        }
      })
      do.call(shiny::tagList,rows)
    })
  })
})

shinyApp(ui=ui,server=server)
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download