R Shiny：如何創建一個「添加字段」按鈕

Question

在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中添加新字段時，它會自動進入代碼中？ （前增加了一個新的輸入$ 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), ] 

    }) 

    }) 

} 
) 

Answer 1

看一看的renderUI功能，使用與在您保存創建IDS這樣的載體一起：

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)