Nest "Add an Input" Within "Add an Input" in R Shiny

Question

In R Shiny, I am able to add additional input fields with an actionButton, using this technique: R Shiny: How to create an "Add Field" Button (call it Section A). Now I want to allow users to add additional input fields within Section A. Basically, I want to nest “Add an Input” within “Add an Input”.

I made a mockup app using the example in the quoted thread. For this particular example, the goal is to allow users to add multiple comments by hitting the "Add Comment" button under each textbox that they have created using the "Add Text" button.

However, with observeEvent({}) nested, I got an error: Error in as.vector: cannot coerce type 'environment' to vector of type 'character'.

ui <- shinyUI(fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(
      actionButton("addText","Add Text"),
      uiOutput("txtOutput"),
      actionButton("getTexts","Get Input Values")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      verbatimTextOutput("txtOut"),
      verbatimTextOutput("cmtOut")
    )
  )))

server <- shinyServer(function(input,output,session){

  ids <<- NULL

  observeEvent(input$addText,{
    if (is.null(ids)){
      ids <<- 1
    }else{
      ids <<- c(ids, max(ids)+1)
    }

    idsa <<- NULL

    output$txtOutput <- renderUI({
        lapply(1:length(ids),function(i){
          textInput(paste0("txtInput",ids[i]), sprintf("Text Input #%d",ids[i]))

          uiOutput(outputId = paste0("cmtOutput", ids[i]))
          actionButton(inputId = paste0("addComment", ids[i]), "Add Comment")


          observeEvent(input[[paste0("addComment",ids[i])]],{
            if (is.null(idsa)){
              idsa <<- 1
            }else{
              idsa <<- c(idsa, max(idsa)+1)
            }
            output[[paste0("cmtOutput",ids[i])]] <- renderUI({
                lapply(1:length(idsa), function(i){
                  textInput(paste0("cmtInput", ids[i], "_", idsa[i]), sprintf("Comment Input #%d", idsa[i]))
                })
            })
          })
          })
    })
  })

  observeEvent(input$getTexts,{
    if(is.null(ids)){
      output$txtOut <- renderPrint({"No textboxes"})
      output$cmtOut <- renderPrint({"No comments"})
    }else{
      txtOut <- list()

      # Get ids for textboxes
      txtbox_ids <- sapply(1:length(ids),function(i){
        paste0("txtInput",ids[i],sep="")
      })

      # Get values
      for(i in 1:length(txtbox_ids)){
        txtOut[[i]] <- sprintf("Txtbox #%d has value: %s",i,input[[ txtbox_ids[i] ]])
      }
        output$txtOut <- renderPrint({txtOut})
        if(is.null(idsa)){
          output$cmtOut <- renderPrint({"No comments"})
        }else{
          cmtOut <- list()

          # Get ids for textboxes
          cmtbox_ids <- sapply(1:length(idsa),function(i){
            paste0("cmtInput",ids[i], "_", idsa[i],sep="")
          })

          # Get values
          for(i in 1:length(cmtbox_ids)){
            cmtOut[[i]] <- sprintf("Comment box #%d has value: %s",i,input[[ cmtbox_ids[i] ]])
          }

      output$cmtOut <- renderPrint({cmtOut})
        }
    }
  })

})

shinyApp(ui=ui,server=server)

Answer 1

I figured it out myself. Just posting for anyone who encounters similar issues. Below is the code for the mockup. Notice the use of if (idsc[i] != input[[paste0("addComment", idsR$v[i])]]) With this syntax missing, when you click "Add Text" twice, and "Add Comment" once for the first textbox, you will see two comments been added. Also notice the use of if (length(idsaR$v[[i]]) != 0){ idsaR$v[[i]] <<- c(idsaR$v[[i]], max(idsaR$v[[i]])+1) } else{ idsaR$v[[i]] <<- c(1) }, if omitting that, after you add comments for textbox #2 and want to go back add comments for textbox #1, there will be an error.

ui <- shinyUI(




  fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(
      actionButton("addText","Add Text"),
      uiOutput("txtOutput"),
      actionButton("getTexts","Get Input Values")
    ),

    # Show a plot of the generated distribution
    mainPanel(
      verbatimTextOutput("txtOut"),
      verbatimTextOutput("cmtOut")
    )
  )))

server <- shinyServer(function(input,output,session){

  ids <<- NULL
  idsR <<- reactiveValues(v = c())
  idsaR <<- reactiveValues(v = list())
  idsc <<- c()


  observeEvent(input$addText,{
    if (is.null(ids)){
      ids <<- 1
    }else{
      ids <<- c(ids, max(ids)+1)
    }
    idsR$v <<- ids

    output$txtOutput <- renderUI({
        lapply(1:length(ids),function(i){
         tagList(
         textInput(paste0("txtInput",idsR$v[i]), sprintf("Text Input #%d",idsR$v[i])),

         uiOutput(outputId = paste0("cmtOutput", idsR$v[i])),
         actionButton(inputId = paste0("addComment", idsR$v[i]), "Add Comment")
          )



          })
    })
  })

  idsc <<- c()

observe({
if (length(idsR$v)!= 0){
lapply(1:length(idsR$v), function(i){
  idsc[i] <<- 0
  observeEvent(input[[paste0("addComment", idsR$v[i])]],{

    if (idsc[i] != input[[paste0("addComment", idsR$v[i])]]){
      if (length(idsaR$v) < i ){
        idsaR$v[[i]] <<- c(1)
      }else{
        if (length(idsaR$v[[i]]) != 0){
        idsaR$v[[i]] <<- c(idsaR$v[[i]], max(idsaR$v[[i]])+1)
        }
        else{
        idsaR$v[[i]] <<- c(1)
      }
      }
    }

    idsc[i] <<- input[[paste0("addComment", idsR$v[i])]]


    output[[paste0("cmtOutput",idsR$v[i])]] <- renderUI({
      lapply(1:length(idsaR$v[[i]]), function(j){
        textInput(paste0("cmtInput", idsR$v[i], "_", idsaR$v[[i]][j]), sprintf("Comment Input #%d, #%s", idsR$v[i], idsaR$v[[i]][j]))
      })
    })
  })
})
}
})




  observeEvent(input$getTexts,{
    if(is.null(idsR$v)){
      output$txtOut <- renderPrint({"No textboxes"})
      output$cmtOut <- renderPrint({"No comments"})
    }else{
      txtOut <- list()
      cmtOut <- list()
      cmtbox_ids <- list()

      # Get ids for textboxes
      txtbox_ids <- sapply(1:length(idsR$v),function(i){
        paste0("txtInput",idsR$v[i],sep="")
      })

      # Get values
      for(i in 1:length(txtbox_ids)){
        txtOut[[i]] <- sprintf("Txtbox #%d has value: %s",i,input[[ txtbox_ids[i] ]])

        if(is.null(idsaR$v)){
          cmtOut <- list("No comments")
        }else{
          cmtOut[[i]] <- list()
          if (length(idsaR$v) >= i){
          # Get ids for commentboxes for the ith textbox
          cmtbox_ids[[i]] <- sapply(1:length(idsaR$v[[i]]),function(j){
            paste0("cmtInput",idsR$v[i], "_", idsaR$v[[i]][j])
          })

          # Get values
          for (j in 1:length(cmtbox_ids[[i]])){
            if(is.null(idsaR$v[[i]])){
            cmtOut[[i]] <- c("No comments")
              }else{
            cmtOut[[i]][j] <- sprintf("Comment box #%d has value: %s",j,input[[ cmtbox_ids[[i]][j] ]])
              }
          }
        }else{
          cmtOut[[i]] <- c("No comments")
        }


        }
      }
        output$txtOut <- renderPrint({txtOut})
        output$cmtOut <- renderPrint({cmtOut})

    }
  })

})

shinyApp(ui=ui,server=server)