1

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)

3 Answers 3

2

Hard to give you a good answer without a reproducible example. I think this should resolve your problem:

## loop over the ids ( we have an event by id)
for(ii in id_list){
  local({
    ## just wrap the observeEvent part under local
    i <- ii
    observeEvent(input[[paste0("remove",i)]],{
    # remove row i
   })
 )}
}
Sign up to request clarification or add additional context in comments.

3 Comments

Could you go into a little more detail about where you would consider placing the for loop? I need to be able to reactively (continuously) monitor a variable number of tags in the "id_list," so that value might be changing a lot - I can't see how a for loop through a changing list might work. I'll try posting a reproducible example soon.
@RupayanNeogy Once you put an example you maybe get more details.
Wrapped this in an observe() in server code as my id_list was a reactive value.
1

It seems that you are looking for shiny module, which lets you create group of ui which work together. You can look at the example at https://shiny.rstudio.com/articles/modules.html. Later on, I will try to adapt it to your problem.

Update: Adaption for shiny module to the problem

library(shiny)

cellUI <- function(id) {
    ns <- NS(id)

    fluidRow(
        selectInput(ns("Feature"),
                    label = "",
                    choices =
                        list("Feature1","Feature2","Feature3"),
                    selected = paste0("Feature", id)),
        actionButton(ns("remove"), label="x")
    )
}

cellSever <- function(input, output, features, feature, session) {
    observeEvent(input$remove, {
        features$renderd[features$renderd == feature] <- NULL
    })
}

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=list(1))

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

    df <- eventReactive(input$goButton, {
        out <- lapply(features$renderd,function(i){
            vn <- paste0('Feature')
            data.frame(Variable=input[[NS(i)(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 (features$renderd[[length(features$renderd)]] > 2) return(NULL)
        features$renderd <- c(features$renderd, features$renderd[[length(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(
                    cellUI(i)
                )
            })
            lapply(features$renderd, function(i) callModule(cellSever, i, features = features, feature = i))
            do.call(shiny::tagList,rows)

        })
    })
})

shinyApp(ui=ui,server=server)

3 Comments

Awesome, I'll look into the link for now - if you can make a solution explaining how to adapt this problem into a Shiny module, I'd be very grateful!
@RupayanNeogy Sorry about the late reply, I've been busy these days. Basically you need to define cellUI and cellServer function. In the cellUI and other places you need to use things like input[[NS(id)("inputname")]], output[[NS(id)("outputname")]] to refer to the specific input and output, and in the cellServer you can just refer to input$inputname and things like that. And you can look into callModule for more details about the cellServer function.
This answer works pretty well, but after playing around I got a more robust solution - it still isn't perfect, so if you or anyone else wants to improve it, that would be great. For now I'll upvote this, but mark my answer as correct since it seems to do what I want it to do the best. Thanks for your help!
0

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)

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.