在R闪亮的“添加输入”中嵌套“添加输入”
在R闪亮的“添加输入”中嵌套“添加输入”
提问于 2018-11-20 23:23:29
在R闪亮中，我可以使用actionButton添加额外的输入字段：R Shiny: How to create an "Add Field" Button (称为A节)。现在，我希望允许用户在A节中添加额外的输入字段--基本上，我希望在“添加输入”中嵌套“添加输入”。
我使用引用的线程中的示例制作了一个模拟应用程序。对于这个特定的例子，目标是允许用户通过点击使用"Add“按钮创建的每个文本框下的"Add注释”按钮来添加多个注释。
但是，对于嵌套的observeEvent({})，我得到了一个错误:as.vector中的错误:无法将类型“环境”强制转换为“字符”类型的向量.
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)回答 1
Stack Overflow用户
回答已采纳
发布于 2018-12-06 21:19:56
我自己想出来的。只是为任何遇到类似问题的人发帖子。下面是模型的代码。注意这个语法缺失的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) }的使用，如果省略了为textbox #2添加注释并想返回textbox #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)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/53403117
复制相关文章
相似问题
腾讯云开发者
