Question

我有一个Shiny应用程序，我想在其中使用操作按钮添加UI元素，然后让插入的ui是动态的。

这是我当前的ui文件：

library(shiny)

shinyUI(fluidPage(
  div(id="placeholder"),
  actionButton("addLine", "Add Line")
))

和服务器文件：

library(shiny)

shinyServer(function(input, output) {
  observeEvent(input$addLine, {
    num <- input$addLine
    id <- paste0("ind", num)
    insertUI(
      selector="#placeholder",
      where="beforeBegin",
      ui={
         fluidRow(column(3, selectInput(paste0("selected", id), label=NULL, choices=c("choice1", "choice2"))))
      })
  })

})

如果在特定的ui元素中选择了choice1，我想向该行添加一个textInput。如果在ui元素中选择了choice2，我想添加一个numericInput。

虽然我通常了解如何创建随用户输入而变化的反应式值，但我不知道该怎么做，因为我不知道如何观察尚未创建的元素，并且我不知道知道名字。任何帮助将不胜感激！

Answer 1

您可以使用insertUI()或renderUI()。如果您想添加相同类型的多个ui，insertUI()很棒，但是我认为这不适用于您。我想您要么想添加数字输入，要么想添加文本输入。

因此，我建议使用renderUI()：

  output$insUI <- renderUI({
      req(input$choice)
      if(input$choice == "choice1") return(fluidRow(column(3,
         textInput(inputId = "text", label=NULL, "sampleText"))))
      if(input$choice == "choice2") return(fluidRow(column(3, 
         numericInput(inputId = "text", label=NULL, 10, 1, 20))))
  })

如果您更喜欢使用insertUI()，则可以使用：

observeEvent(input$choice, {
  if(input$choice == "choice1") insUI <- fluidRow(column(3, textInput(inputId 
                                = "text", label=NULL)))
  if(input$choice == "choice2") insUI <- fluidRow(column(3, 
                                numericInput(inputId = "text", label=NULL, 10, 1, 20)))

  insertUI(
    selector="#placeholderInput",
    where="beforeBegin",
    ui={
      insUI
    })
})

并且在用户界面方面：div(id="placeholderInput")。

完整代码如下：

library(shiny)

ui <- shinyUI(fluidPage(
  div(id="placeholderChoice"),
  uiOutput("insUI"),
  actionButton("addLine", "Add Line")
))


server <- shinyServer(function(input, output) {
  observeEvent(input$addLine, {
    insertUI(
      selector="#placeholderChoice",
      where="beforeBegin",
      ui={
        fluidRow(column(3, selectInput(inputId = "choice", label=NULL, 
                 choices=c("choice1", "choice2"))))
      })
  })

  output$insUI <- renderUI({
      req(input$choice)
      if(input$choice == "choice1") return(fluidRow(column(3,
         textInput(inputId = "text", label=NULL, "sampleText"))))
      if(input$choice == "choice2") return(fluidRow(column(3, 
         numericInput(inputId = "text", label=NULL, 10, 1, 20))))
  })

})

shinyApp(ui, server)

Answer 2

代码

可以通过modules轻松解决：

library(shiny)

row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(3, 
           selectInput(ns("type_chooser"), 
                       label = "Choose Type:", 
                       choices = c("text", "numeric"))
    ),
    column(9,
           uiOutput(ns("ui_placeholder"))
    )
  )
} 

row_server <- function(input, output, session) {
  return_value <- reactive({input$inner_element})
  ns <- session$ns
  output$ui_placeholder <- renderUI({
    type <- req(input$type_chooser)
    if(type == "text") {
      textInput(ns("inner_element"), "Text:")
    } else if (type == "numeric") {
      numericInput(ns("inner_element"), "Value:", 0)
    }
  })

  ## if we later want to do some more sophisticated logic
  ## we can add reactives to this list
  list(return_value = return_value) 
}

ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("addLine", "Add Line"),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {
  handler <- reactiveVal(list())
  observeEvent(input$addLine, {
    new_id <- paste("row", input$addLine, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })

  output$out <- renderPrint({
    lapply(handler(), function(handle) {
      handle()
    })
  })
}

shinyApp(ui, server)

说明

一个模块是一段模块化的代码，您可以根据需要多次重复使用它，而不必担心唯一的名称，因为该模块在namespaces的帮助下进行了处理。

一个模块由两部分组成：

一个UI函数
一个server函数

它们与普通的UI和server函数非常相似，但请注意以下几点：

namespacing：在服务器中，您可以像通常一样从UI访问元素，例如input$type_chooser。但是，在UI部分，您必须使用namespace NS元素，该元素返回一个可以方便地在其余代码中使用的函数。为此，UI函数采用参数id，该参数可以看作该模块任何实例的（唯一）名称空间。元素ids在模块中必须是唯一的，并且由于使用了命名空间，即使您使用模块的多个实例，它们在整个应用程序中也将是唯一的。
UI：由于您的UI是一个函数，返回值只有一个，因此，如果您想将元素包装在tagList中，返回一个以上的元素（此处不需要）。
server：您需要session参数，否则该参数是可选的。如果您希望模块与主应用程序进行通信，则可以传入（响应）参数，您可以在模块中照常使用该参数。同样，如果希望主应用程序使用模块中的某些值，则应返回代码中所示的反应式。如果您想从服务器函数中创建UI元素，则还需要为其命名空间，并且无法通过session$ns来访问命名空间函数，如图所示。
usage：要使用您的模块，请通过使用唯一的UI调用函数，将id部分插入主应用程序。然后，您必须调用callModule才能使服务器逻辑正常工作，并在其中传递相同的id。该调用的返回值是模块服务器函数的returnValue，并且可以在主应用程序中被起诉以与模块中的值一起使用。

这简述了模块。 here.

是一个非常好的教程，它对模块进行了更详细和完整的解释。

insertUI中的R闪亮动态UI

2 个答案: