Question

在R Shiny中，我已经能够使用以下技术实现使用actionButton插入输入字段的功能：R Shiny: How to create an "Add Field" Button（称为A节）。现在，在A节中，我想添加另一个节，该节允许用户使用另一个actionButton插入其他字段（B节）。所以B部分在A部分之内。

我使用引用的线程中的示例制作了一个样机应用程序。对于此特定示例，目标是允许用户通过单击使用“添加文本”按钮创建的每个文本框下方的“添加评论”按钮来添加多个评论。现在，嵌套了observeEvent（{}），我得到了一个错误： as.vector中的错误：无法将类型“ environment”强制为“ 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

我自己弄清楚了。只要发给遇到类似问题的任何人。下面是样机的代码。注意使用 if (idsc[i] != input[[paste0("addComment", idsR$v[i])]]) 缺少此语法的情况下，当您单击“添加文本”两次，并为第一个文本框单击一次“添加注释”时，您将看到添加了两个注释。另请注意 if (length(idsaR$v[[i]]) != 0){ idsaR$v[[i]] <<- c(idsaR$v[[i]], max(idsaR$v[[i]])+1) } else{ idsaR$v[[i]] <<- c(1) }，如果忽略了这一点，那么在为文本框2添加注释并要返回为文本框1添加注释后，就会出现错误。

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)

在R Shiny中的“添加输入”中嵌套“添加输入”

1 个答案: