RShiny 中的动态表单

Question

这是早期查询 [Creating asymmetric layouts involving rows and column in Shiny 的扩展。我正在尝试创建动态 UI 输出。需要建议通过将每个“主题”的下拉菜单和文本框组合在一起来修复布局，以及如何从动态创建的各种下拉菜单和文本框中捕获数据。

这是之前查询的修改后的代码 [How to add/remove input fields dynamically by a button in shiny:

library(shiny)

ui <- shinyUI(fluidPage(
sidebarPanel(
actionButton("add_btn", "Add Textbox"),
actionButton("rm_btn", "Remove Textbox"),
textOutput("counter")
),
mainPanel(
  fluidRow(column(6,uiOutput("selectbox_ui"), offset = 0), 
 column(6,fluidRow(column(6,uiOutput("textbox_ui1"), uiOutput("textbox_ui2"))),
    fluidRow(column(6,uiOutput("textbox_ui3"), uiOutput("textbox_ui4"),offset = 0)), offset = 0)
  )
)))

server <- shinyServer(function(input, output, session) { session$onSessionEnded(stopApp)

# Track the number of input boxes to render
counter <- reactiveValues(n = 0)

observeEvent(input$add_btn, {counter$n <- counter$n + 1})
observeEvent(input$rm_btn, {if (counter$n > 0) counter$n <- counter$n - 1})

output$counter <- renderPrint(print(counter$n))

textboxes1 <- reactive({n <- counter$n
 if (n > 0) 
  {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin1", i),label = paste0("Textbox_A_Topic", i), value = "Hello World!")})}
 })

textboxes2 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin2", i),label = paste0("Textbox_B_Topic", i), value = "Hello World!")}    )}
 })
textboxes3 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin3", i),label = paste0("Textbox_C_Topic", i), value = "Hello World!")}    )}
 })
textboxes4 <- reactive({n <- counter$n
  if (n > 0) 
   {lapply(seq_len(n), function(i) {textInput(inputId = paste0("textin4", i),label = paste0("Textbox_D_Topic", i), value = "Hello World!")}     )}
 })
selectboxes <- reactive({n <- counter$n
   if (n > 0) 
    {lapply(seq_len(n), function(i) {selectInput(inputId = paste0("selectTopic", i), label = paste0("Topic", i), 
                                                 choices = c("one", "two", "three"), selected = "two", multiple = FALSE)})}
 })

output$textbox_ui1 <- renderUI(textboxes1())
output$textbox_ui2 <- renderUI({textboxes2() })
output$textbox_ui3 <- renderUI({textboxes3() })
output$textbox_ui4 <- renderUI({textboxes4() })
output$selectbox_ui <- renderUI({selectboxes()})

})

Answer 1

为了解决您的布局问题，将与单个主题相关的所有元素（即下拉菜单和四个文本输入）视为形成一个元素块会有所帮助。然后找到一种方法来创建这些块中的一个（将过程提取到一个函数中也是一个好主意），然后继续堆叠这些块以获得所需的结果。

在您的示例中创建完整主题块的函数可能如下所示：

topic_ui <- function(i) {

  # render all elements related to a single topic into one div

  fluidRow(

    # drop-down select menu on the left
    column(width = 6, offset = 0,
      selectInput(
        inputId = paste0("selectTopic", i),
        label   = paste0("Topic", i),
        choices = c("one", "two", "three"),
        selected = "two",
        multiple = FALSE
      )
    ),

    # text boxes on the right
    column(width = 6, offset = 0,
      lapply(LETTERS[1:4], function(l) {
        textInput(
          inputId = paste0("textin", l, i),
          label   = paste0("Textbox_", l, "_Topic", i),
          value   = "Hello World!"
        )
      })
    )

  )

}

现在需要修改服务器以使用新的主题 ui 创建器功能：

server <- shinyServer(function(input, output, session) {

  session$onSessionEnded(stopApp)

  # Track the number of input boxes to render
  counter <- reactiveValues(n = 0)

  observeEvent(input$add_btn, {
    counter$n <- counter$n + 1
  })

  observeEvent(input$rm_btn, {
    if (counter$n > 0)
      counter$n <- counter$n - 1
  })

  output$counter <- renderPrint(print(counter$n))

  # render a number of topic ui elements based on the counter,
  # each consisting of a selectInput and four textInputs
  topics <- reactive({
    n <- counter$n
    if (n > 0)
      lapply(seq_len(n), topic_ui)
  })

  output$topic_ui <- renderUI(topics())

})

最后，ui端也可以这样简化：

ui <- shinyUI(fluidPage(

  sidebarPanel(

    actionButton("add_btn", "Add Textbox"),
    actionButton("rm_btn", "Remove Textbox"),
    textOutput("counter")

  ),

  mainPanel(

    # dynamically created ui elements

    uiOutput("topic_ui")

  )

))

至于从动态元素中捕获输入，原则上您只需按照与任何静态输入元素相同的方式进行操作：通过inputId 参数中给出的名称来引用它。不过，作为一个复杂因素，我想您必须先包含一些检查以查看动态元素是否存在。如果您扩展您的示例案例以包含您想对动态输入执行的操作，我可以尝试再次查看！