问题
In R Shiny is there a way to have a button that says "add field" that, when clicked, will add another text input box? I would want to take this code:
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!")
)
)))
and reduce it to :
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!")
)
)))
with an option to add as many fields as the user would like as far as terms.
Also, how would we recode the server so that when a new field is added in the ui it automatically goes into the code as well? (ex. adds a new input$wordx into list):
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), ]
})
})
}
)
回答1:
Have a look at the renderUI
function, use that together with a vector where you save the created ids like this:
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)
来源:https://stackoverflow.com/questions/33485186/r-shiny-how-to-create-an-add-field-button