如何在R Shiny中将insertUI()输出添加到renderText()输出?

时间:2017-09-20 01:09:33

标签: r shiny

我正在开发一个闪亮的应用程序来为系统开发提供自动化,我需要一种方法来为用户输入添加文本框,并将结果用户输入添加到renderText()输出。我不确定是否有办法循环通过反应值,所以现在我不得不在textInput()结果中对标签进行特定调用。代码如下,请注意,需要更改的部分是服务器部分底部的输出$ value部分:

library(shiny)
ui <- fluidPage(
            fluidRow(
                column(6,
                    textInput("mainDesc1", label = "Main Description", value = "", width = '100%')
                    ),
                column(1,
                    actionButton(inputId = 'insertBtn', label = "More")
                    ),
                column(1,
                    actionButton(inputId = 'removeBtn', label = "Less")
                    )
                ),
            tags$div(id = 'placeholder'),
            fluidRow(column(12, verbatimTextOutput("value")))
)

server <- function(input, output) {
    ## keep track of elements inserted and not yet removed
    inserted <- c()
    #btn <- 1
    observeEvent(input$insertBtn, {
        btn <- input$insertBtn + 1
        id <- paste0("mainDesc", btn)
        insertUI(
            selector = '#placeholder',
        ## wrap element in a div with id for ease of removal
            ui = tags$div(
                tags$p(fluidRow(
                    column(6,
                        textInput(paste("mainDesc", btn + 1, sep = ""), label = "", value = "", width = '100%')
                        )
                    )
                ),
                id = id
                )
            )
        inserted <<- c(id, inserted)
    })

    observeEvent(input$removeBtn, {
        removeUI(
        ## pass in appropriate div id
          selector = paste0('#', inserted[length(inserted)])
        )
        inserted <<- inserted[-length(inserted)]
    })

    output$value <- renderText({ noquote(paste(input[[paste("mainDesc", 1, sep = "")]], "\n",
                                               input[[paste("mainDesc", btn + 1, sep = "")]], sep = ""))
                                               })
    }
shinyApp(ui = ui, server = server)

如何循环显示由于

而弹出的userInput()框的结果
textInput(paste("mainDesc", btn + 1, sep = ""), label = "", value = "", width = '100%')

逐行粘贴上述所有现有输出?基本上,我要找的是用户输入&#34;第一行&#34;在第一个&#34;主要描述&#34;文本框,点击&#34;更多&#34;按钮添加&#34;第二行&#34;在弹出的文本框中,再次单击更多并键入&#34; 3rd line&#34;在弹出文本框中,renderText()框输出:

1st line
2nd line
3rd line

如果添加了更多文本框,则应将用户输入逐行添加到renderText()输出中。谢谢!

1 个答案:

答案 0 :(得分:1)

尝试btn reactiveValue

vals <- reactiveValues(btn = 1)
# reference elsewhere in your app as vals$btn

在这里查看似乎正常工作的代码:

library(shiny)

ui <- fluidPage(
  fluidRow(
    column(6,
           textInput("mainDesc1", label = "Main Description", value = "", width = '100%')
    ),
    column(1,
           actionButton(inputId = 'insertBtn', label = "More")
    ),
    column(1,
           actionButton(inputId = 'removeBtn', label = "Less")
    )
  ),
  tags$div(id = 'placeholder'),
  fluidRow(column(12, verbatimTextOutput("value", placeholder = T)))
)

server <- function(input, output) {
  ## keep track of elements inserted and not yet removed
  vals <- reactiveValues(btn = 0)

  observeEvent(input$insertBtn, {
    vals$btn <- vals$btn + 1
    insertUI(
      selector = '#placeholder',
      ## wrap element in a div with id for ease of removal
      ui = tags$div(
        id = paste0('line', vals$btn),
        tags$p(fluidRow(
          column(6,
                 textInput(paste("mainDesc", vals$btn + 1, sep = ""), label = paste("Line", vals$btn), value = "", width = '100%')
                 )
          )
        )
      )
    )
  })

  observeEvent(input$removeBtn, {
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#line', vals$btn)
    )
    vals$btn <- vals$btn - 1
  })

  output$value <- renderText({ 
    msg <- c(input[["mainDesc1"]])
    if (vals$btn > 0) {
      for (i in 1:vals$btn) {
        msg <- c(msg, input[[paste0("mainDesc", i + 1)]])
      }
      msg <- paste(msg, collapse = "\n")  
    }
  })
}

shinyApp(ui = ui, server = server)