R Shiny：如何创建“添加字段”按钮

Posted 2023-04-18

【中文标题】R Shiny：如何创建“添加字段”按钮

【英文标题】：R Shiny: How to create an "Add Field" Button

【发布时间】：2016-02-02 18:47:36

【问题描述】：

在 R Shiny 中，有没有办法让一个按钮显示“添加字段”，单击该按钮会添加另一个文本输入框？我想用这个代码：

shinyUI(fluidPage(
  titlePanel("Resume Text Analysis"),

  sidebarLayout(position = "right",
    mainPanel(h2("Qualified Applicants"), dataTableOutput("table")),
    sidebarPanel(h2("Specifications"),

      textInput("filepath", label = h4("Paste the file path for the folder of '.txt' files you would like included in the analysis.")),

      helpText("Choose up to 10 words that a qualified applicant should have in their resume. These can be skills, programming languages, certifications, etc."),

      textInput("word1", label = h3("Term 1"), 
        value = ""),
      textInput("word2", label = h3("Term 2"), 
        value = ""),
      textInput("word3", label = h3("Term 3"), 
        value = ""),
      textInput("word4", label = h3("Term 4"), 
        value = ""),
      textInput("word5", label = h3("Term 5"), 
        value = ""),
      textInput("word6", label = h3("Term 6"), 
        value = ""),
      textInput("word7", label = h3("Term 7"), 
        value = ""),
      textInput("word8", label = h3("Term 8"), 
        value = ""),
      textInput("word9", label = h3("Term 9"), 
        value = ""),
      textInput("word10", label = h3("Term 10"), 
        value = ""),

      helpText("A qualified applicant will have a resume with at least ___ of the terms above."),

      numericInput("morethan", 
        label = h3("Number of terms required:"), 
        min = 1, max = 9, value = 1),

      submitButton("Analyze!")

    )

)))

并将其简化为：

shinyUI(fluidPage(
  titlePanel("Resume Text Analysis"),

  sidebarLayout(position = "right",
    mainPanel(h2("Qualified Applicants"), dataTableOutput("table")),
    sidebarPanel(h2("Specifications"),

      textInput("filepath", label = h4("Paste the file path for the folder of '.txt' files you would like included in the analysis.")),


         helpText("Choose up to 10 words that a qualified applicant should have in their resume. These can be skills, programming languages, certifications, etc."),

          textInput("word1", label = h3("Term 1"), 
            value = ""),
helpText("A qualified applicant will have a resume with at least ___ of the terms above."),

      numericInput("morethan", 
        label = h3("Number of terms required:"), 
        min = 1, max = 9, value = 1),

      submitButton("Analyze!")

    )

)))

可以选择根据用户的需要添加尽可能多的字段。

另外，我们如何重新编码服务器，以便在用户界面中添加新字段时，它也会自动进入代码中？ （例如，将新的 input$wordx 添加到列表中）：

library(tm)

shinyServer(
  function(input, output) 
    observe(
      if(is.null(input$filepath) || nchar(input$filepath)  == 0) return(NULL)

      if(!dir.exists(input$filepath)) return(NULL)
      output$table <- renderDataTable(
        as.data.frame(qualified)
      )

      cname <- file.path(input$filepath)

      dir(cname) 
      length(dir(cname))

      docs <- Corpus(DirSource(cname)) 
      toSpace <- content_transformer(function(x, pattern) gsub(pattern, " ", x))
      docs <- tm_map(docs, toSpace, "/|@|\\|")
      docs <- tm_map(docs, content_transformer(tolower))
      docs <- tm_map(docs, removePunctuation)
      docs <- tm_map(docs, removeWords, stopwords ("english"))
      docs <- tm_map(docs, removeNumbers)
      dtm <- DocumentTermMatrix(docs)

      d <- c(input$word1, input$word2, input$word3, input$word4, input$word5, input$word6, input$word7, input$word8, input$word9, input$word10)

      list<-DocumentTermMatrix(docs,list(dictionary = d))

      relist=as.data.frame(as.matrix(list))

      res<- do.call(cbind,lapply(names(relist),function(n) ifelse(relist[n] > 0, 1,0)))

      totals <- rowSums(res, na.rm=TRUE)

      docname=dir(cname)

      wordtotals=cbind(docname, totals)

      num = input$morethan

      df <- data.frame("document"=docname, "total"=totals)
      output$table <- renderDataTable(
        df[df$total >= as.numeric(num), ]

     )

  )


)

【问题讨论】：

使用 renderUI 并在服务器中使用与添加的元素名称匹配的输入。

【参考方案1】：

查看renderUI 函数，将其与保存创建的 id 的向量一起使用，如下所示：

ui <- shinyUI(fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(
      actionButton("addInput","Add Input"),
      uiOutput("inputs"),
      actionButton("getTexts","Get Input Values")
    ),

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

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

  ids <<- NULL

  observeEvent(input$addInput,
    print(ids)
    if (is.null(ids))
      ids <<- 1
    else
      ids <<- c(ids, max(ids)+1)
    
    output$inputs <- renderUI(
      tagList(
        lapply(1:length(ids),function(i)
          textInput(paste0("txtInput",ids[i]), sprintf("Text Input #%d",ids[i]))
        )
      )
    )
  )

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

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

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

)

shinyApp(ui=ui,server=server)