RShiny中的动态形式

时间:2017-08-24 17:48:27

标签: r shiny

这是早期查询[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()})

})

1 个答案:

答案 0 :(得分: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 creator function:

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参数中给出的名称引用它。作为一个复杂的问题,我想你必须先包含一些检查,看看动态元素是否首先存在。如果您扩展示例案例以包含您想要对动态输入执行的操作,我可以尝试重新审视一下!