2

在 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!")

    )

)))

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

另外，我们如何重新编码服务器，以便在 ui 中添加新字段时，它也会自动进入代码中？（例如，将新的 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), ]

     })

  })

}
)
4

1 回答 1

4

看一下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)
于 2015-11-03T10:24:37.270 回答